From fd378a1c49940001dc5b399db4a1f548177c3101 Mon Sep 17 00:00:00 2001 From: Akash Dhiraj Date: Sat, 27 Jul 2024 11:48:30 -0400 Subject: [PATCH] Setup CI (#45) This PR closes #43 by making the following changes - move DSL tests from `bin/main.ml` to `test/well_formed.ml` - set up CI according to issue #43 and @anshumanmohan's comment below - fill in `dune-project` --- .github/workflows/format.yml | 31 ++++++++++++++++ .github/workflows/test.yml | 33 +++++++++++++++++ dsl_lang/bin/dune | 3 +- dsl_lang/bin/main.ml | 70 ------------------------------------ dsl_lang/dsl_lang.opam | 20 ++++++----- dsl_lang/dune-project | 33 +++++++++++++++-- dsl_lang/lib/eval.ml | 39 ++++++++++---------- dsl_lang/lib/util.ml | 29 ++++++--------- dsl_lang/test/dune | 3 ++ dsl_lang/test/well_formed.ml | 56 +++++++++++++++++++++++++++++ 10 files changed, 197 insertions(+), 120 deletions(-) create mode 100644 .github/workflows/format.yml create mode 100644 .github/workflows/test.yml create mode 100644 dsl_lang/test/dune create mode 100644 dsl_lang/test/well_formed.ml diff --git a/.github/workflows/format.yml b/.github/workflows/format.yml new file mode 100644 index 0000000..a9368d0 --- /dev/null +++ b/.github/workflows/format.yml @@ -0,0 +1,31 @@ +name: Format + +on: + push: + pull_request: + branches: [main] + +# Ensures that only the latest commit of a PR can execute the actions. +# Useful for cancelling job when a sequence of commits are quickly added. +concurrency: + group: ${{ github.head_ref || github.run_id }} + cancel-in-progress: true + +jobs: + format: + runs-on: ubuntu-latest + steps: + - name: Checkout + uses: actions/checkout@v4 + - name: Set-up OCaml + uses: ocaml/setup-ocaml@v3 + with: + ocaml-compiler: 5 + - name: Install ocamlformat + working-directory: dsl_lang + run: opam install ocamlformat + - name: Check format + working-directory: dsl_lang + run: | + [ $(opam exec -- dune fmt 2> >(wc -c)) -eq 0 ] + diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml new file mode 100644 index 0000000..c90f791 --- /dev/null +++ b/.github/workflows/test.yml @@ -0,0 +1,33 @@ +name: Test + +on: + push: + pull_request: + branches: [main] + +# Ensures that only the latest commit of a PR can execute the actions. +# Useful for cancelling job when a sequence of commits are quickly added. +concurrency: + group: ${{ github.head_ref || github.run_id }} + cancel-in-progress: true + +jobs: + test: + runs-on: ubuntu-latest + steps: + - name: Checkout + uses: actions/checkout@v4 + - name: Set-up OCaml + uses: ocaml/setup-ocaml@v3 + with: + ocaml-compiler: 5 + - name: Install dependencies + working-directory: dsl_lang + run: | + opam install . --deps-only + - name: DSL tests + working-directory: dsl_lang + run: | + opam exec -- dune build + opam exec -- dune test + diff --git a/dsl_lang/bin/dune b/dsl_lang/bin/dune index c7d7b2b..842aeca 100644 --- a/dsl_lang/bin/dune +++ b/dsl_lang/bin/dune @@ -1,3 +1,4 @@ (executable + (public_name dsl_lang) (name main) - (libraries dsl_core ounit2)) + (libraries dsl_core)) diff --git a/dsl_lang/bin/main.ml b/dsl_lang/bin/main.ml index 2710f9c..e69de29 100644 --- a/dsl_lang/bin/main.ml +++ b/dsl_lang/bin/main.ml @@ -1,70 +0,0 @@ -open Dsl_core -open OUnit2 - -(* The test suite for running our interpreter. *) - -let eval_prog (filename : string) = - let res = Parse.parse_file filename in - Eval.eval res - -let make_test (name : string) (filename : string) (val_str : string) = - name >:: fun _ -> - assert_equal val_str - (Util.string_of_policy (eval_prog filename)) - ~printer:(fun x -> x) - -let make_error_test (name : string) (filename : string) (exn : exn) = - name >:: fun _ -> - assert_raises exn (fun () -> - try Util.string_of_policy (eval_prog filename) - with Eval.UnboundVariable _ -> raise exn) - -let tests = - [ - make_test "single class policy" "../../dsl/progs/now/drop_a_class.sched" "A"; - make_test "fifo sugar 1 class" - "../../dsl/progs/now/fifo_1_class_sugar.sched" "A"; - make_test "fifo 1 class" "../../dsl/progs/now/fifo_1_class.sched" "A"; - make_test "fifo of 3" "../../dsl/progs/now/fifo_n_classes.sched" - "fifo[A, B, C]"; - make_test "rr of 1" "../../dsl/progs/now/rr_1_class.sched" "rr[A]"; - make_test "rr of 2" "../../dsl/progs/now/rr_2_classes.sched" "rr[A, B]"; - make_test "multiple assignments" - "../../dsl/progs/now/rr_hier_merge_sugar.sched" - "rr[fifo[BX, BY], rr[RP, RT]]"; - make_test "2 assignments w/ substitutions" - "../../dsl/progs/now/rr_hier.sched" "rr[B, rr[RP, RT]]"; - make_test "3 classes with substitutions" - "../../dsl/progs/soon/rr_n_class_hier.sched" - "rr[A, B, rr[rr[CU, CV], rr[CW, CX]]]"; - make_test "rr of 3" "../../dsl/progs/soon/rr_n_classes.sched" "rr[A, B, C]"; - make_test "rr and strict substitutions" - "../../dsl/progs/soon/rr_strict_n_classes_hier.sched" - "strict[A, B, rr[rr[CU, CV], strict[CW, CX]]]"; - make_test "strict of 3" "../../dsl/progs/soon/strict_n_classes.sched" - "strict[A, B, C]"; - make_test "leaky bucket of 2" "../../dsl/progs/nwc/leaky_2_classes.sched" - "leaky[[A, B], width = 5, buffer = 10]"; - make_test "token bucket of 2 round robins" "../../dsl/progs/nwc/token_2_rr_children.sched" - "token[[rr[A, B], rr[C, D]], width = 20, time = 50]"; - make_test "stop and go with 3 classes" "../../dsl/progs/nwc/sg_3_classes.sched" - "stopandgo[[stopandgo[[A, B], width = 10], stopandgo[[C], width = 10]], width = 5]"; - make_test "rcsp for 4 classes" "../../dsl/progs/nwc/rcsp_4_classes.sched" - "rcsp[A, B, C, D]"; - - ] - -let error_tests = - [ - make_error_test "undeclared class" - "../../dsl/progs/incorrect/undeclared_classes.sched" - (Eval.UnboundVariable "..."); - make_error_test "unbound variable" - "../../dsl/progs/incorrect/unbound_var.sched" (Eval.UnboundVariable "..."); - make_error_test "unbound var in middle of list of assignments" - "../../dsl/progs/incorrect/unbound_var_hier.sched" - (Eval.UnboundVariable "..."); - ] - -let suite = "suite" >::: tests @ error_tests -let () = run_test_tt_main suite diff --git a/dsl_lang/dsl_lang.opam b/dsl_lang/dsl_lang.opam index 1cd1d95..abe3f30 100644 --- a/dsl_lang/dsl_lang.opam +++ b/dsl_lang/dsl_lang.opam @@ -2,16 +2,18 @@ opam-version: "2.0" synopsis: "A short synopsis" description: "A longer description" -maintainer: ["Maintainer Name"] -authors: ["Author Name"] -license: "LICENSE" -tags: ["topics" "to describe" "your" "project"] -homepage: "https://github.com/username/reponame" -doc: "https://url/to/documentation" -bug-reports: "https://github.com/username/reponame/issues" +maintainer: [ + "Anshuman Mohan" "Cassandra Sziklai" "Kabir Samsi" "Akash Dhiraj" +] +authors: ["Anshuman Mohan" "Cassandra Sziklai" "Kabir Samsi" "Akash Dhiraj"] +license: "MIT" +homepage: "https://github.com/cucapra/packet-scheduling" +bug-reports: "https://github.com/cucapra/packet-scheduling/issues" depends: [ "ocaml" - "dune" {>= "3.10"} + "dune" {>= "3.16"} + "ounit2" + "menhir" "odoc" {with-doc} ] build: [ @@ -28,4 +30,4 @@ build: [ "@doc" {with-doc} ] ] -dev-repo: "git+https://github.com/username/reponame.git" +dev-repo: "git+https://github.com/cucapra/packet-scheduling.git" diff --git a/dsl_lang/dune-project b/dsl_lang/dune-project index 8f0fd88..8414931 100644 --- a/dsl_lang/dune-project +++ b/dsl_lang/dune-project @@ -1,2 +1,31 @@ -(lang dune 3.10) -(using menhir 2.1) +(lang dune 3.16) + +(name dsl_lang) + +(generate_opam_files true) + +(source + (github cucapra/packet-scheduling)) + +(authors + "Anshuman Mohan" + "Cassandra Sziklai" + "Kabir Samsi" + "Akash Dhiraj") + +(maintainers + "Anshuman Mohan" + "Cassandra Sziklai" + "Kabir Samsi" + "Akash Dhiraj") + +(license MIT) + +(using menhir 3.0) + +(package + (name dsl_lang) + (synopsis "DSL for Programmable Packet Scheduling") + (description "TBD") + (depends ocaml dune ounit2 menhir)) + diff --git a/dsl_lang/lib/eval.ml b/dsl_lang/lib/eval.ml index 95869ad..56b2a3a 100644 --- a/dsl_lang/lib/eval.ml +++ b/dsl_lang/lib/eval.ml @@ -24,15 +24,14 @@ let rec lookup s x : policy = (* Helper function that evaulates a policy list. *) let rec eval_plist (pl : policy list) (st : store) (cl : classes) = - match pl with - | [] -> pl - | h :: t -> eval_pol h st cl :: eval_plist t st cl + match pl with [] -> pl | h :: t -> eval_pol h st cl :: eval_plist t st cl (* Helper function that evaluates a weighted policy list. *) and eval_weighted_plist (pl : (policy * int) list) (st : store) (cl : classes) = match pl with | [] -> pl - | (pol, weight) :: t -> (eval_pol pol st cl, weight) :: eval_weighted_plist t st cl + | (pol, weight) :: t -> + (eval_pol pol st cl, weight) :: eval_weighted_plist t st cl (* Evaluates a policy, looking up any variables and substituting them in. *) and eval_pol (p : policy) (st : store) (cl : classes) : policy = @@ -46,25 +45,25 @@ and eval_pol (p : policy) (st : store) (cl : classes) : policy = | Fifo (h :: t) -> Fifo (eval_pol h st cl :: eval_plist t st cl) | RoundRobin (h :: t) -> RoundRobin (eval_pol h st cl :: eval_plist t st cl) | Strict (h :: t) -> Strict (eval_pol h st cl :: eval_plist t st cl) - | WeightedFair((pol, weight) :: t) - -> WeightedFair(((eval_pol pol st cl), weight) :: (eval_weighted_plist t st cl)) - | EarliestDeadline (h :: t) - -> EarliestDeadline (eval_pol h st cl :: eval_plist t st cl) - | ShortestJobNext (h :: t) - -> ShortestJobNext (eval_pol h st cl :: eval_plist t st cl) - | ShortestRemaining (h :: t) - -> ShortestRemaining (eval_pol h st cl :: eval_plist t st cl) - | RateControlled (h :: t) - -> RateControlled (eval_pol h st cl :: eval_plist t st cl) - | LeakyBucket(lst, n1, n2) -> LeakyBucket((eval_plist lst st cl), n1, n2) - | TokenBucket(lst, n1, n2) -> TokenBucket((eval_plist lst st cl), n1, n2) - | StopAndGo(lst, n) -> StopAndGo((eval_plist lst st cl), n) - + | WeightedFair ((pol, weight) :: t) -> + WeightedFair ((eval_pol pol st cl, weight) :: eval_weighted_plist t st cl) + | EarliestDeadline (h :: t) -> + EarliestDeadline (eval_pol h st cl :: eval_plist t st cl) + | ShortestJobNext (h :: t) -> + ShortestJobNext (eval_pol h st cl :: eval_plist t st cl) + | ShortestRemaining (h :: t) -> + ShortestRemaining (eval_pol h st cl :: eval_plist t st cl) + | RateControlled (h :: t) -> + RateControlled (eval_pol h st cl :: eval_plist t st cl) + | LeakyBucket (lst, n1, n2) -> LeakyBucket (eval_plist lst st cl, n1, n2) + | TokenBucket (lst, n1, n2) -> TokenBucket (eval_plist lst st cl, n1, n2) + | StopAndGo (lst, n) -> StopAndGo (eval_plist lst st cl, n) | _ -> failwith "cannot have empty policy" (* A function to evaluate all the assignments in a program by updating the store with the variable and the policy it maps to. *) -let rec eval_assn (alist : assignment list) (st : store) (cl : classes) : store = +let rec eval_assn (alist : assignment list) (st : store) (cl : classes) : store + = match alist with | [] -> st | (var, pol) :: t -> @@ -76,7 +75,7 @@ let rec eval_assn (alist : assignment list) (st : store) (cl : classes) : store let eval_helper (prog : program) (st : store) (cl : classes) : policy = let clist, alist, ret = prog in let cl' = cl @ clist in - let st' = eval_assn alist st cl' in + let st' = eval_assn alist st cl' in eval_pol ret st' cl' (* Outermost function that is called by main.ml *) diff --git a/dsl_lang/lib/util.ml b/dsl_lang/lib/util.ml index a150c1d..190ccca 100644 --- a/dsl_lang/lib/util.ml +++ b/dsl_lang/lib/util.ml @@ -3,15 +3,16 @@ exception ParserError of string (** Takes a policy and returns the string representation of it. **) let rec string_of_policy (pol : Ast.policy) : string = - (* Helper function to compactly join policy lists by comma *) let join lst = lst |> List.map string_of_policy |> String.concat ", " in (* Helper function to compactly join weighted policy lists by comma *) - let join_weighted lst = lst - |> List.map - (fun (x, y) -> "(" ^ string_of_policy x ^ ", " ^ string_of_int y ^ ")") - |> String.concat ", " in + let join_weighted lst = + lst + |> List.map (fun (x, y) -> + "(" ^ string_of_policy x ^ ", " ^ string_of_int y ^ ")") + |> String.concat ", " + in match pol with | Class c -> c @@ -19,24 +20,16 @@ let rec string_of_policy (pol : Ast.policy) : string = | RoundRobin lst -> "rr[" ^ join lst ^ "]" | Strict lst -> "strict[" ^ join lst ^ "]" | WeightedFair lst -> "strict[" ^ join_weighted lst ^ "]" - | EarliestDeadline lst -> "edf[" ^ join lst ^ "]" | ShortestJobNext lst -> "sjn[" ^ join lst ^ "]" | ShortestRemaining lst -> "srtf[" ^ join lst ^ "]" | RateControlled lst -> "rcsp[" ^ join lst ^ "]" - | LeakyBucket (lst, width, buffer) -> - "leaky[[" ^ join lst ^ "], width = " - ^ string_of_int width ^ ", buffer = " + "leaky[[" ^ join lst ^ "], width = " ^ string_of_int width ^ ", buffer = " ^ string_of_int buffer ^ "]" - | TokenBucket (lst, width, buffer) -> - "token[[" ^ join lst ^ "], width = " - ^ string_of_int width ^ ", time = " + "token[[" ^ join lst ^ "], width = " ^ string_of_int width ^ ", time = " ^ string_of_int buffer ^ "]" - - | StopAndGo (lst, width) -> - "stopandgo[[" ^ join lst ^ "], width = " - ^ string_of_int width ^ "]" - - | Var _ -> raise(NonTerminal) + | StopAndGo (lst, width) -> + "stopandgo[[" ^ join lst ^ "], width = " ^ string_of_int width ^ "]" + | Var _ -> raise NonTerminal diff --git a/dsl_lang/test/dune b/dsl_lang/test/dune new file mode 100644 index 0000000..4ef948f --- /dev/null +++ b/dsl_lang/test/dune @@ -0,0 +1,3 @@ +(tests + (names well_formed) + (libraries dsl_core ounit2)) diff --git a/dsl_lang/test/well_formed.ml b/dsl_lang/test/well_formed.ml new file mode 100644 index 0000000..402f209 --- /dev/null +++ b/dsl_lang/test/well_formed.ml @@ -0,0 +1,56 @@ +open Dsl_core +open OUnit2 + +(* The test suite for running our interpreter. *) + +let prefix = "../../../../dsl/progs/" + +let eval_prog (filename : string) = + let res = Parse.parse_file (prefix ^ filename) in + Eval.eval res + +let make_test (name : string) (filename : string) (val_str : string) = + name >:: fun _ -> + assert_equal val_str + (Util.string_of_policy (eval_prog filename)) + ~printer:(fun x -> x) + +let make_error_test (name : string) (filename : string) (exn : exn) = + name >:: fun _ -> + assert_raises exn (fun () -> + try Util.string_of_policy (eval_prog filename) + with Eval.UnboundVariable _ -> raise exn) + +let tests = + [ + make_test "single class policy" "now/drop_a_class.sched" "A"; + make_test "fifo sugar 1 class" "now/fifo_1_class_sugar.sched" "A"; + make_test "fifo 1 class" "now/fifo_1_class.sched" "A"; + make_test "fifo of 3" "now/fifo_n_classes.sched" "fifo[A, B, C]"; + make_test "rr of 1" "now/rr_1_class.sched" "rr[A]"; + make_test "rr of 2" "now/rr_2_classes.sched" "rr[A, B]"; + make_test "multiple assignments" "now/rr_hier_merge_sugar.sched" + "rr[fifo[BX, BY], rr[RP, RT]]"; + make_test "2 assignments w/ substitutions" "now/rr_hier.sched" + "rr[B, rr[RP, RT]]"; + make_test "3 classes with substitutions" "soon/rr_n_class_hier.sched" + "rr[A, B, rr[rr[CU, CV], rr[CW, CX]]]"; + make_test "rr of 3" "soon/rr_n_classes.sched" "rr[A, B, C]"; + make_test "rr and strict substitutions" + "soon/rr_strict_n_classes_hier.sched" + "strict[A, B, rr[rr[CU, CV], strict[CW, CX]]]"; + make_test "strict of 3" "soon/strict_n_classes.sched" "strict[A, B, C]"; + ] + +let error_tests = + [ + make_error_test "undeclared class" "incorrect/undeclared_classes.sched" + (Eval.UnboundVariable "..."); + make_error_test "unbound variable" "incorrect/unbound_var.sched" + (Eval.UnboundVariable "..."); + make_error_test "unbound var in middle of list of assignments" + "incorrect/unbound_var_hier.sched" (Eval.UnboundVariable "..."); + ] + +let suite = "suite" >::: tests @ error_tests +let () = run_test_tt_main suite