From 0997540ae2397359381e7f28c254baa7352644bb Mon Sep 17 00:00:00 2001 From: Aliya Hameer Date: Sun, 14 Jul 2019 21:08:03 -0400 Subject: [PATCH 1/7] Mutation testing functionality --- demo-repository/exercises/demo/solution.ml | 7 + demo-repository/exercises/demo/template.ml | 6 + demo-repository/exercises/demo/test.ml | 55 ++++-- src/grader/dune | 6 +- src/grader/mutation_test.ml | 206 +++++++++++++++++++++ src/grader/mutation_test.mli | 62 +++++++ src/ppx-metaquot/ty.ml | 23 +++ src/ppx-metaquot/ty.mli | 4 + 8 files changed, 355 insertions(+), 14 deletions(-) create mode 100644 src/grader/mutation_test.ml create mode 100644 src/grader/mutation_test.mli diff --git a/demo-repository/exercises/demo/solution.ml b/demo-repository/exercises/demo/solution.ml index cb7e63583..096ec194b 100644 --- a/demo-repository/exercises/demo/solution.ml +++ b/demo-repository/exercises/demo/solution.ml @@ -1,4 +1,11 @@ let plus = (+) +let plus_tests = [((1, 1), 2)] + let times = ( * ) +let times_tests = [((2, 2), 4)] + let minus = ( - ) +let minus_tests = [((1, 1), 0)] + let divide = ( / ) +let divide_tests = [((2, 2), 1)] diff --git a/demo-repository/exercises/demo/template.ml b/demo-repository/exercises/demo/template.ml index 8292e5d81..552c1a268 100644 --- a/demo-repository/exercises/demo/template.ml +++ b/demo-repository/exercises/demo/template.ml @@ -1,6 +1,12 @@ let plus x y = x + y ;; +let plus_tests = [ + ((1, 1), 2) +] let minus x y = y - x ;; +let minus_tests = [ + ((1, 2), 1) +] let times x y = x * diff --git a/demo-repository/exercises/demo/test.ml b/demo-repository/exercises/demo/test.ml index 91ca022bd..d488923de 100644 --- a/demo-repository/exercises/demo/test.ml +++ b/demo-repository/exercises/demo/test.ml @@ -1,26 +1,57 @@ open Test_lib open Report +module Mutation_test = Mutation_test.Make (Test_lib) +open Mutation_test + +let test_plus () = + test_function_2_against_solution + [%ty : int -> int -> int ] "plus" + [ (1, 1) ; (2, 2) ; (10, -10) ] + @ + test_unit_tests_2 + [%ty : int -> int -> int ] "plus" + [ fun x y -> x - y ] + +let test_minus () = + test_function_2_against_solution + [%ty : int -> int -> int ] "minus" + [ (1, 1) ; (4, -2) ; (0, 10) ] + @ + test_unit_tests_2 + [%ty : int -> int -> int ] "minus" + [ fun x y -> x + y ] + +let test_times () = + test_function_2_against_solution + [%ty : int -> int -> int ] "times" + [ (1, 3) ; (2, 4) ; (3, 0) ] + @ + test_unit_tests_2 + [%ty: int -> int -> int ] "times" + [ fun x y -> x / y ] + +let test_divide () = + test_function_2_against_solution + [%ty : int -> int -> int ] "divide" + [ (12, 4) ; (12, 5) ; (3, 0) ] + @ + test_unit_tests_2 + [%ty : int -> int -> int ] "divide" + [ fun x y -> x * y ] + let () = set_result @@ ast_sanity_check code_ast @@ fun () -> [ Section ([ Text "Function:" ; Code "plus" ], - test_function_2_against_solution - [%ty : int -> int -> int ] "plus" - [ (1, 1) ; (2, 2) ; (10, -10) ]) ; + test_plus ()) ; Section ([ Text "Function:" ; Code "minus" ], - test_function_2_against_solution - [%ty : int -> int -> int ] "minus" - [ (1, 1) ; (4, -2) ; (0, 10) ]) ; + test_minus ()) ; Section ([ Text "Function:" ; Code "times" ], - test_function_2_against_solution - [%ty : int -> int -> int ] "times" - [ (1, 3) ; (2, 4) ; (3, 0) ]) ; + test_times ()) ; Section ([ Text "Function:" ; Code "divide" ], - test_function_2_against_solution - [%ty : int -> int -> int ] "divide" - [ (12, 4) ; (12, 5) ; (3, 0) ]) ] + test_divide ()) ] diff --git a/src/grader/dune b/src/grader/dune index aa78c19bc..b251d9973 100644 --- a/src/grader/dune +++ b/src/grader/dune @@ -27,7 +27,8 @@ learnocaml_repository) (modules Introspection_intf Introspection - Test_lib) + Test_lib + Mutation_test) (modules_without_implementation Introspection_intf) (preprocess (pps learnocaml_ppx_metaquot)) ) @@ -106,7 +107,8 @@ ../ppx-metaquot/.ty.objs/ty.cmi .testing.objs/introspection_intf.cmi .learnocaml_report.objs/learnocaml_report.cmi - .testing.objs/test_lib.cmi)) + .testing.objs/test_lib.cmi + .testing.objs/mutation_test.cmi)) (action (with-stdout-to %{targets} (run ocp-ocamlres -format ocamlres %{compiler-cmis} %{generated-cmis}))) ) diff --git a/src/grader/mutation_test.ml b/src/grader/mutation_test.ml new file mode 100644 index 000000000..3975fce16 --- /dev/null +++ b/src/grader/mutation_test.ml @@ -0,0 +1,206 @@ +open Learnocaml_report + +type 'a test_result = + | Pass + | Fail of 'a + | Err of exn + +let run_test_against f (input, expected) = + try + let output = f input in + if output = expected then Pass + else Fail output + with exn -> Err exn + +let run_test_against_mutant f (input, expected) = + match run_test_against f (input, expected) with + | Pass -> false + | _ -> true + + +let uncurry2 f = fun (x, y) -> f x y +let uncurry3 f = fun (x, y, z) -> f x y z +let uncurry4 f = fun (x, y, z, w) -> f x y z w + +module type S = sig + val test_unit_tests_1: + ?points: int -> + ('a -> 'b) Ty.ty -> string -> ('a -> 'b) list -> Learnocaml_report.t + val test_unit_tests_2: + ?points: int -> + ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) list -> Learnocaml_report.t + val test_unit_tests_3: + ?points: int -> + ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd) list -> Learnocaml_report.t + val test_unit_tests_4: + ?points: int -> + ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd -> 'e) list -> Learnocaml_report.t +end + +module Make (Test_lib: Test_lib.S) : S = struct + open Test_lib + + let typed_printer ty = + let typed_printer ppf v = Introspection.print_value ppf v ty in + Format.asprintf "%a" typed_printer + let string_of_exn = typed_printer [%ty: exn] + + let test_against_mutant ~points mut name tests = + let result = List.exists (run_test_against_mutant mut) tests in + if result then + Message + ([Text "Your tests successfully revealed the bug in implementation"; Text name], + Success points) + else + Message + ([Text "Your tests did not expose the bug in implementation"; Text name], + Failure) + + let test_against_solution soln printer out_printer (input, expected) = + let msg = Message ([Text "Running test"; Code (printer input)], Informative) in + let expected_str = out_printer expected in + let result = run_test_against soln (input, expected) in + let report = + match result with + | Pass -> [Message ([Text "Test passed with output"; + Code expected_str], + Success 0)] + | Fail _ -> + [Message ([Text "Test failed: expected output"; + Code expected_str; + Text "but got something else"], + Failure)] + | Err exn -> + [Message ([Text "Test failed: expected output"; + Code expected_str; + Text "but got an unexpected exception"; + Code (string_of_exn exn)], + Failure)] + in + msg :: report + + + let test_against_mutants ~points muts tests = + let string_of_num x = "#" ^ (string_of_int x) in + let test_against_mutant_i i mut = + test_against_mutant ~points mut (string_of_num (succ i)) tests + in + List.mapi test_against_mutant_i muts + + let test_report soln_report maybe_mut_report = + let soln_section = + Section ([Text "...against the solution"], soln_report) + in + let mut_report = + match maybe_mut_report with + | None -> + [Message ([Text "Some of your tests are incorrect and need to be fixed"], + Failure)] + | Some report -> + [Section ([Text "...against our buggy implementations"], report)] + in + soln_section :: mut_report + + let test ~points test_ty printer out_printer name soln muts = + let test_name = name ^ "_tests" in + let report = + test_variable_property test_ty test_name @@ + fun tests -> + if List.length tests = 0 then + [Message ([Text "You have not yet written any test cases."], Failure)] + else + let tester = test_against_solution soln printer out_printer in + let soln_report = + List.fold_right (fun test acc -> (tester test) @ acc) tests [] + in + let maybe_mut_report = + if snd (Learnocaml_report.result soln_report) then None + else Some (test_against_mutants ~points muts tests) + in + test_report soln_report maybe_mut_report + in + [Section ([Text "Your tests..."], report)] + + + let test_unit_tests_1 ?(points=1) ty name muts = + let (domain, range) = Ty.domains ty in + let test_ty = Ty.lst (Ty.pair2 domain range) in + let in_printer = typed_printer domain in + let printer input = name ^ " " ^ (in_printer input) in + let out_printer = typed_printer range in + let soln = lookup_solution ty name () in + match soln with + | `Unbound (_, report) -> report (* this should never happen *) + | `Found (_, _, soln) -> + test ~points test_ty printer out_printer name soln muts + + let test_unit_tests_2 ?(points=1) ty name muts = + let (dom1, rng) = Ty.domains ty in + let (dom2, range) = Ty.domains rng in + let test_ty = Ty.lst (Ty.pair2 (Ty.pair2 dom1 dom2) range) in + let in1_printer = typed_printer dom1 in + let in2_printer = typed_printer dom2 in + let printer (in1, in2) = + name ^ " " ^ (in1_printer in1) ^ " " ^ (in2_printer in2) + in + let out_printer = typed_printer range in + let muts = List.map uncurry2 muts in + let soln = lookup_solution ty name () in + match soln with + | `Unbound (_, report) -> report (* this should never happen *) + | `Found (_, _, soln) -> + let soln = uncurry2 soln in + test ~points test_ty printer out_printer name soln muts + + let test_unit_tests_3 ?(points=1) ty name muts = + let (dom1, rng1) = Ty.domains ty in + let (dom2, rng2) = Ty.domains rng1 in + let (dom3, range) = Ty.domains rng2 in + let test_ty = + Ty.lst (Ty.pair2 (Ty.pair3 dom1 dom2 dom3) range) + in + let in1_printer = typed_printer dom1 in + let in2_printer = typed_printer dom2 in + let in3_printer = typed_printer dom3 in + let printer (in1, in2, in3) = + name ^ " " ^ (in1_printer in1) + ^ " " ^ (in2_printer in2) + ^ " " ^ (in3_printer in3) + in + let out_printer = typed_printer range in + let muts = List.map uncurry3 muts in + let soln = lookup_solution ty name () in + match soln with + | `Unbound (_, report) -> report (* this should never happen *) + | `Found (_, _, soln) -> + let soln = uncurry3 soln in + test ~points test_ty printer out_printer name soln muts + + let test_unit_tests_4 ?(points=1) ty name muts = + let (dom1, rng1) = Ty.domains ty in + let (dom2, rng2) = Ty.domains rng1 in + let (dom3, rng3) = Ty.domains rng2 in + let (dom4, range) = Ty.domains rng3 in + let test_ty = + Ty.lst (Ty.pair2 (Ty.pair4 dom1 dom2 dom3 dom4) range) + in + let in1_printer = typed_printer dom1 in + let in2_printer = typed_printer dom2 in + let in3_printer = typed_printer dom3 in + let in4_printer = typed_printer dom4 in + let printer (in1, in2, in3, in4) = + name ^ " " ^ (in1_printer in1) + ^ " " ^ (in2_printer in2) + ^ " " ^ (in3_printer in3) + ^ " " ^ (in4_printer in4) + in + let out_printer = typed_printer range in + let muts = List.map uncurry4 muts in + let soln = lookup_solution ty name () in + match soln with + | `Unbound (_, report) -> report (* this should never happen *) + | `Found (_, _, soln) -> + let soln = uncurry4 soln in + test ~points test_ty printer out_printer name soln muts + +end diff --git a/src/grader/mutation_test.mli b/src/grader/mutation_test.mli new file mode 100644 index 000000000..91ce2b699 --- /dev/null +++ b/src/grader/mutation_test.mli @@ -0,0 +1,62 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2016-2018 OCamlPro. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +type 'a test_result = + | Pass + | Fail of 'a + | Err of exn + +(** Run a test (a pair of input and expected output) on a function. *) +val run_test_against: ('a -> 'b) -> ('a * 'b) -> 'b test_result + +(** Run a test (a pair of input and expected output) on a mutant. + Returns true if the mutant *fails* the test, either by deviating + from the expected output or by raising an error. + Returns false if the mutant *passes* the test. +*) +val run_test_against_mutant: ('a -> 'b) -> ('a * 'b) -> bool + +(** Running mutation tests on a student's test suite. + For testing a function called [foo], the student's tests should + be in a variable called [foo_tests]. + This module needs to be instantiated with an instance of + Test_lib, which is available to the grader code: + + {[ + module M = Mutation_test.Make (Test_lib) + + M.test_unit_tests_1 ... + ]} + + A grading function is defined for each arity function from + one to four: + + [test_unit_tests_ ty name mutants] + grades unit tests for the [args_nb]-arity function named + [name], which are stored in the variable called [name_tests], + against the broken implementations in the list [mutants]. + + The optional argument [~points] specifies how many points + should be given for each mutant exposed by the test suite. +*) +module type S = sig + val test_unit_tests_1: + ?points: int -> + ('a -> 'b) Ty.ty -> string -> ('a -> 'b) list -> Learnocaml_report.t + val test_unit_tests_2: + ?points: int -> + ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) list -> Learnocaml_report.t + val test_unit_tests_3: + ?points: int -> + ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd) list -> Learnocaml_report.t + val test_unit_tests_4: + ?points: int -> + ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd -> 'e) list -> Learnocaml_report.t +end + +module Make (Test_lib: Test_lib.S) : S diff --git a/src/ppx-metaquot/ty.ml b/src/ppx-metaquot/ty.ml index dab0d0ffa..d8b85e182 100644 --- a/src/ppx-metaquot/ty.ml +++ b/src/ppx-metaquot/ty.ml @@ -25,3 +25,26 @@ let curry (Ty arg) (Ty ret) = Ty { Parsetree.ptyp_desc = Parsetree.Ptyp_arrow (Asttypes.Nolabel, arg, ret) ; ptyp_loc = Location.none ; ptyp_attributes = [] } + +let pair2 (Ty t1) (Ty t2) = + Ty {Parsetree.ptyp_desc = Parsetree.Ptyp_tuple [t1; t2]; + ptyp_loc = Location.none; + ptyp_attributes = []} + +let pair3 (Ty t1) (Ty t2) (Ty t3) = + Ty {Parsetree.ptyp_desc = Parsetree.Ptyp_tuple [t1; t2; t3]; + ptyp_loc = Location.none; + ptyp_attributes = []} + +let pair4 (Ty t1) (Ty t2) (Ty t3) (Ty t4) = + Ty {Parsetree.ptyp_desc = Parsetree.Ptyp_tuple [t1; t2; t3; t4]; + ptyp_loc = Location.none; + ptyp_attributes = []} + +let lst (Ty ty) = + Ty {Parsetree.ptyp_desc = + Parsetree.Ptyp_constr ({Asttypes.txt = Longident.Lident "list"; + loc = Location.none}, + [ty]); + ptyp_loc = Location.none; + ptyp_attributes = []} diff --git a/src/ppx-metaquot/ty.mli b/src/ppx-metaquot/ty.mli index 19507f409..e000dff50 100644 --- a/src/ppx-metaquot/ty.mli +++ b/src/ppx-metaquot/ty.mli @@ -20,3 +20,7 @@ val repr: Parsetree.core_type -> 'a ty val print: 'a ty -> string val domains: ('a -> 'b) ty -> 'a ty * 'b ty val curry: 'a ty -> 'b ty -> ('a -> 'b) ty +val pair2: 'a ty -> 'b ty -> ('a * 'b) ty +val pair3: 'a ty -> 'b ty -> 'c ty -> ('a * 'b * 'c) ty +val pair4: 'a ty -> 'b ty -> 'c ty -> 'd ty -> ('a * 'b * 'c * 'd) ty +val lst: 'a ty -> ('a list) ty From b1c5bbaccc0d8bd3576c02c8029583cefda883f2 Mon Sep 17 00:00:00 2001 From: Aliya Hameer Date: Thu, 8 Aug 2019 17:45:20 -0400 Subject: [PATCH 2/7] Mutation testing: require descriptive names for mutants --- demo-repository/exercises/demo/descr.html | 34 ++++++++++++++++++++++ demo-repository/exercises/demo/template.ml | 7 +++-- demo-repository/exercises/demo/test.ml | 8 ++--- src/grader/mutation_test.ml | 32 +++++++++++++------- src/grader/mutation_test.mli | 16 +++++++--- 5 files changed, 76 insertions(+), 21 deletions(-) diff --git a/demo-repository/exercises/demo/descr.html b/demo-repository/exercises/demo/descr.html index dcc05ad1f..16fd26914 100644 --- a/demo-repository/exercises/demo/descr.html +++ b/demo-repository/exercises/demo/descr.html @@ -9,18 +9,52 @@

The task

integer-arithmetic functions.

+

+ You are also asked to write test suites for these functions. A test + suite is specified as a list of input/expected output pairs. These + tests will be run against some buggy programs to test their coverage. +

+
  1. Write a function plus of type int -> int -> int. +
      +
    • + Write some test cases for this function in the variable + plus_tests. Your test cases should be pairs of type + (int * int) * int. +
      • +
  2. Write a function minus of type int -> int -> int. +
      +
    • + Write some test cases for this function in the variable + minus_tests. Your test cases should be pairs of type + (int * int) * int. +
      • +
  3. Write a function times of type int -> int -> int. +
      +
    • + Write some test cases for this function in the variable + times_tests. Your test cases should be pairs of type + (int * int) * int. +
      • +
  4. Write a function divide of type int -> int -> int. +
      +
    • + Write some test cases for this function in the variable + divide_tests. Your test cases should be pairs of type + (int * int) * int. +
      • +
diff --git a/demo-repository/exercises/demo/template.ml b/demo-repository/exercises/demo/template.ml index 552c1a268..ad209cb14 100644 --- a/demo-repository/exercises/demo/template.ml +++ b/demo-repository/exercises/demo/template.ml @@ -1,12 +1,13 @@ let plus x y = x + y ;; let plus_tests = [ - ((1, 1), 2) -] + ((1, 1), 2); + ((1, 0), 1) +];; let minus x y = y - x ;; let minus_tests = [ ((1, 2), 1) -] +];; let times x y = x * diff --git a/demo-repository/exercises/demo/test.ml b/demo-repository/exercises/demo/test.ml index d488923de..ad6123f4b 100644 --- a/demo-repository/exercises/demo/test.ml +++ b/demo-repository/exercises/demo/test.ml @@ -11,7 +11,7 @@ let test_plus () = @ test_unit_tests_2 [%ty : int -> int -> int ] "plus" - [ fun x y -> x - y ] + [ ("Subtracts instead of adding", fun x y -> x - y) ] let test_minus () = test_function_2_against_solution @@ -20,7 +20,7 @@ let test_minus () = @ test_unit_tests_2 [%ty : int -> int -> int ] "minus" - [ fun x y -> x + y ] + [ ("Adds instead of subtracting", fun x y -> x + y) ] let test_times () = test_function_2_against_solution @@ -29,7 +29,7 @@ let test_times () = @ test_unit_tests_2 [%ty: int -> int -> int ] "times" - [ fun x y -> x / y ] + [ ("Divides instead of multiplying", fun x y -> x / y) ] let test_divide () = test_function_2_against_solution @@ -38,7 +38,7 @@ let test_divide () = @ test_unit_tests_2 [%ty : int -> int -> int ] "divide" - [ fun x y -> x * y ] + [ ("Multiplies instead of dividing", fun x y -> x * y) ] let () = set_result @@ diff --git a/src/grader/mutation_test.ml b/src/grader/mutation_test.ml index 3975fce16..b3b75fcc1 100644 --- a/src/grader/mutation_test.ml +++ b/src/grader/mutation_test.ml @@ -5,6 +5,8 @@ type 'a test_result = | Fail of 'a | Err of exn +type 'a mutant = string * 'a + let run_test_against f (input, expected) = try let output = f input in @@ -21,20 +23,27 @@ let run_test_against_mutant f (input, expected) = let uncurry2 f = fun (x, y) -> f x y let uncurry3 f = fun (x, y, z) -> f x y z let uncurry4 f = fun (x, y, z, w) -> f x y z w +let map_snd f = fun (x, y) -> (x, f y) module type S = sig val test_unit_tests_1: ?points: int -> - ('a -> 'b) Ty.ty -> string -> ('a -> 'b) list -> Learnocaml_report.t + ('a -> 'b) Ty.ty -> string -> ('a -> 'b) mutant list -> Learnocaml_report.t val test_unit_tests_2: ?points: int -> - ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) list -> Learnocaml_report.t + ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) mutant list -> Learnocaml_report.t val test_unit_tests_3: ?points: int -> - ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd) list -> Learnocaml_report.t + ('a -> 'b -> 'c -> 'd) Ty.ty + -> string + -> ('a -> 'b -> 'c -> 'd) mutant list + -> Learnocaml_report.t val test_unit_tests_4: ?points: int -> - ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd -> 'e) list -> Learnocaml_report.t + ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty + -> string + -> ('a -> 'b -> 'c -> 'd -> 'e) mutant list + -> Learnocaml_report.t end module Make (Test_lib: Test_lib.S) : S = struct @@ -45,15 +54,18 @@ module Make (Test_lib: Test_lib.S) : S = struct Format.asprintf "%a" typed_printer let string_of_exn = typed_printer [%ty: exn] - let test_against_mutant ~points mut name tests = + let test_against_mutant ~points (name, mut) num tests = let result = List.exists (run_test_against_mutant mut) tests in if result then Message - ([Text "Your tests successfully revealed the bug in implementation"; Text name], + ([Text "Your tests successfully revealed the bug in implementation"; + Text num; + Text ": "; + Text name], Success points) else Message - ([Text "Your tests did not expose the bug in implementation"; Text name], + ([Text "Your tests did not expose the bug in implementation"; Text num], Failure) let test_against_solution soln printer out_printer (input, expected) = @@ -144,7 +156,7 @@ module Make (Test_lib: Test_lib.S) : S = struct name ^ " " ^ (in1_printer in1) ^ " " ^ (in2_printer in2) in let out_printer = typed_printer range in - let muts = List.map uncurry2 muts in + let muts = List.map (map_snd uncurry2) muts in let soln = lookup_solution ty name () in match soln with | `Unbound (_, report) -> report (* this should never happen *) @@ -168,7 +180,7 @@ module Make (Test_lib: Test_lib.S) : S = struct ^ " " ^ (in3_printer in3) in let out_printer = typed_printer range in - let muts = List.map uncurry3 muts in + let muts = List.map (map_snd uncurry3) muts in let soln = lookup_solution ty name () in match soln with | `Unbound (_, report) -> report (* this should never happen *) @@ -195,7 +207,7 @@ module Make (Test_lib: Test_lib.S) : S = struct ^ " " ^ (in4_printer in4) in let out_printer = typed_printer range in - let muts = List.map uncurry4 muts in + let muts = List.map (map_snd uncurry4) muts in let soln = lookup_solution ty name () in match soln with | `Unbound (_, report) -> report (* this should never happen *) diff --git a/src/grader/mutation_test.mli b/src/grader/mutation_test.mli index 91ce2b699..2730b30db 100644 --- a/src/grader/mutation_test.mli +++ b/src/grader/mutation_test.mli @@ -11,6 +11,8 @@ type 'a test_result = | Fail of 'a | Err of exn +type 'a mutant = string * 'a + (** Run a test (a pair of input and expected output) on a function. *) val run_test_against: ('a -> 'b) -> ('a * 'b) -> 'b test_result @@ -47,16 +49,22 @@ val run_test_against_mutant: ('a -> 'b) -> ('a * 'b) -> bool module type S = sig val test_unit_tests_1: ?points: int -> - ('a -> 'b) Ty.ty -> string -> ('a -> 'b) list -> Learnocaml_report.t + ('a -> 'b) Ty.ty -> string -> ('a -> 'b) mutant list -> Learnocaml_report.t val test_unit_tests_2: ?points: int -> - ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) list -> Learnocaml_report.t + ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) mutant list -> Learnocaml_report.t val test_unit_tests_3: ?points: int -> - ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd) list -> Learnocaml_report.t + ('a -> 'b -> 'c -> 'd) Ty.ty + -> string + -> ('a -> 'b -> 'c -> 'd) mutant list + -> Learnocaml_report.t val test_unit_tests_4: ?points: int -> - ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd -> 'e) list -> Learnocaml_report.t + ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty + -> string + -> ('a -> 'b -> 'c -> 'd -> 'e) mutant list + -> Learnocaml_report.t end module Make (Test_lib: Test_lib.S) : S From 448bf4e2cb8c85e03a8fe96972bf4042529629e2 Mon Sep 17 00:00:00 2001 From: Aliya Hameer Date: Thu, 8 Aug 2019 17:47:05 -0400 Subject: [PATCH 3/7] Mutation testing: add option to run tests on own implementation --- src/grader/mutation_test.ml | 173 ++++++++++++++++++++++++++--------- src/grader/mutation_test.mli | 19 ++++ 2 files changed, 147 insertions(+), 45 deletions(-) diff --git a/src/grader/mutation_test.ml b/src/grader/mutation_test.ml index b3b75fcc1..4417bc7c1 100644 --- a/src/grader/mutation_test.ml +++ b/src/grader/mutation_test.ml @@ -28,22 +28,27 @@ let map_snd f = fun (x, y) -> (x, f y) module type S = sig val test_unit_tests_1: ?points: int -> + ?test_student_soln: bool -> ('a -> 'b) Ty.ty -> string -> ('a -> 'b) mutant list -> Learnocaml_report.t val test_unit_tests_2: ?points: int -> + ?test_student_soln: bool -> ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) mutant list -> Learnocaml_report.t val test_unit_tests_3: ?points: int -> + ?test_student_soln: bool -> ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd) mutant list -> Learnocaml_report.t val test_unit_tests_4: ?points: int -> + ?test_student_soln: bool -> ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd -> 'e) mutant list -> Learnocaml_report.t + val passed_mutation_testing: Learnocaml_report.t -> bool end module Make (Test_lib: Test_lib.S) : S = struct @@ -68,19 +73,21 @@ module Make (Test_lib: Test_lib.S) : S = struct ([Text "Your tests did not expose the bug in implementation"; Text num], Failure) - let test_against_solution soln printer out_printer (input, expected) = + let test_against_fn ?(show_output=false) f printer out_printer (input, expected) = let msg = Message ([Text "Running test"; Code (printer input)], Informative) in let expected_str = out_printer expected in - let result = run_test_against soln (input, expected) in + let result = run_test_against f (input, expected) in let report = match result with | Pass -> [Message ([Text "Test passed with output"; Code expected_str], Success 0)] - | Fail _ -> + | Fail out -> [Message ([Text "Test failed: expected output"; Code expected_str; - Text "but got something else"], + Text "but got"; + if show_output then Code (out_printer out) + else Text "something else"], Failure)] | Err exn -> [Message ([Text "Test failed: expected output"; @@ -91,6 +98,10 @@ module Make (Test_lib: Test_lib.S) : S = struct in msg :: report + let section_header = "Your tests..." + let soln_header = "...against the solution" + let mutation_header = "...against our buggy implementations" + let stud_header = "...against your implementation" let test_against_mutants ~points muts tests = let string_of_num x = "#" ^ (string_of_int x) in @@ -99,54 +110,117 @@ module Make (Test_lib: Test_lib.S) : S = struct in List.mapi test_against_mutant_i muts - let test_report soln_report maybe_mut_report = + let test_report soln_report stud_section maybe_mut_report = let soln_section = - Section ([Text "...against the solution"], soln_report) + Section ([Text soln_header], soln_report) in let mut_report = match maybe_mut_report with | None -> - [Message ([Text "Some of your tests are incorrect and need to be fixed"], - Failure)] + Message ([Text "Some of your tests are incorrect and need to be fixed"], + Failure) | Some report -> - [Section ([Text "...against our buggy implementations"], report)] + Section ([Text mutation_header], report) in - soln_section :: mut_report + soln_section :: mut_report :: stud_section + + let passed_mutation_testing report = + match report with + | [Section ([Text title], items)] when String.equal title section_header -> + (* Remove the student implementation section, if present *) + let report' = + List.filter + (function + | Section ([Text title], _) -> + not (String.equal title stud_header) + | _ -> true) + items + in + not (snd (Learnocaml_report.result report')) + | _ -> false + + type 'a lookup = + | Unbound of Learnocaml_report.t + | Found of 'a + + let no_test_cases_report = + [Message ([Text "You have not yet written any test cases."], Failure)] + let soln_not_found_msg = + Message ([Text "Reference solution not found."; + Text "This is an error with the grader."; + Text "Please contact your instructor."], + Failure) + + let append_map f l = + List.fold_right (fun x acc -> (f x) @ acc) l [] + + let test_soln_report soln printer out_printer tests = + match soln with + | Unbound report -> soln_not_found_msg :: report + | Found soln -> + let tester = test_against_fn soln printer out_printer in + append_map tester tests + + let test_stud_section stud printer out_printer tests = + match stud with + | None -> [] + | Some lookup -> + let stud_report = + match lookup with + | Unbound report -> report + | Found stud -> + let tester = + test_against_fn ~show_output: true stud printer out_printer + in + append_map tester tests + in + [Section ([Text stud_header], stud_report)] - let test ~points test_ty printer out_printer name soln muts = + let test ~points test_ty printer out_printer name soln stud muts = let test_name = name ^ "_tests" in let report = test_variable_property test_ty test_name @@ fun tests -> if List.length tests = 0 then - [Message ([Text "You have not yet written any test cases."], Failure)] + no_test_cases_report else - let tester = test_against_solution soln printer out_printer in - let soln_report = - List.fold_right (fun test acc -> (tester test) @ acc) tests [] - in + let soln_report = test_soln_report soln printer out_printer tests in + let stud_section = test_stud_section stud printer out_printer tests in let maybe_mut_report = if snd (Learnocaml_report.result soln_report) then None else Some (test_against_mutants ~points muts tests) in - test_report soln_report maybe_mut_report + test_report soln_report stud_section maybe_mut_report in - [Section ([Text "Your tests..."], report)] + [Section ([Text section_header], report)] + + let process_lookup process lookup ty name = + match lookup ty name () with + | `Unbound (_, report) -> Unbound report + | `Found (_, _, data) -> Found (process data) - let test_unit_tests_1 ?(points=1) ty name muts = + let test_unit_tests_1 + ?(points = 1) + ?(test_student_soln = true) + ty name muts = let (domain, range) = Ty.domains ty in let test_ty = Ty.lst (Ty.pair2 domain range) in let in_printer = typed_printer domain in let printer input = name ^ " " ^ (in_printer input) in let out_printer = typed_printer range in - let soln = lookup_solution ty name () in - match soln with - | `Unbound (_, report) -> report (* this should never happen *) - | `Found (_, _, soln) -> - test ~points test_ty printer out_printer name soln muts + let soln = process_lookup (fun x -> x) lookup_solution ty name in + let stud = + if test_student_soln then + Some (process_lookup (fun x -> x) lookup_student ty name) + else None + in + test ~points test_ty printer out_printer name soln stud muts - let test_unit_tests_2 ?(points=1) ty name muts = + let test_unit_tests_2 + ?(points = 1) + ?(test_student_soln = true) + ty name muts = let (dom1, rng) = Ty.domains ty in let (dom2, range) = Ty.domains rng in let test_ty = Ty.lst (Ty.pair2 (Ty.pair2 dom1 dom2) range) in @@ -157,14 +231,18 @@ module Make (Test_lib: Test_lib.S) : S = struct in let out_printer = typed_printer range in let muts = List.map (map_snd uncurry2) muts in - let soln = lookup_solution ty name () in - match soln with - | `Unbound (_, report) -> report (* this should never happen *) - | `Found (_, _, soln) -> - let soln = uncurry2 soln in - test ~points test_ty printer out_printer name soln muts + let soln = process_lookup uncurry2 lookup_solution ty name in + let stud = + if test_student_soln then + Some (process_lookup uncurry2 lookup_student ty name) + else None + in + test ~points test_ty printer out_printer name soln stud muts - let test_unit_tests_3 ?(points=1) ty name muts = + let test_unit_tests_3 + ?(points = 1) + ?(test_student_soln = true) + ty name muts = let (dom1, rng1) = Ty.domains ty in let (dom2, rng2) = Ty.domains rng1 in let (dom3, range) = Ty.domains rng2 in @@ -181,14 +259,18 @@ module Make (Test_lib: Test_lib.S) : S = struct in let out_printer = typed_printer range in let muts = List.map (map_snd uncurry3) muts in - let soln = lookup_solution ty name () in - match soln with - | `Unbound (_, report) -> report (* this should never happen *) - | `Found (_, _, soln) -> - let soln = uncurry3 soln in - test ~points test_ty printer out_printer name soln muts + let soln = process_lookup uncurry3 lookup_solution ty name in + let stud = + if test_student_soln then + Some (process_lookup uncurry3 lookup_student ty name) + else None + in + test ~points test_ty printer out_printer name soln stud muts - let test_unit_tests_4 ?(points=1) ty name muts = + let test_unit_tests_4 + ?(points = 1) + ?(test_student_soln = true) + ty name muts = let (dom1, rng1) = Ty.domains ty in let (dom2, rng2) = Ty.domains rng1 in let (dom3, rng3) = Ty.domains rng2 in @@ -208,11 +290,12 @@ module Make (Test_lib: Test_lib.S) : S = struct in let out_printer = typed_printer range in let muts = List.map (map_snd uncurry4) muts in - let soln = lookup_solution ty name () in - match soln with - | `Unbound (_, report) -> report (* this should never happen *) - | `Found (_, _, soln) -> - let soln = uncurry4 soln in - test ~points test_ty printer out_printer name soln muts + let soln = process_lookup uncurry4 lookup_solution ty name in + let stud = + if test_student_soln then + Some (process_lookup uncurry4 lookup_student ty name) + else None + in + test ~points test_ty printer out_printer name soln stud muts end diff --git a/src/grader/mutation_test.mli b/src/grader/mutation_test.mli index 2730b30db..c30dcf197 100644 --- a/src/grader/mutation_test.mli +++ b/src/grader/mutation_test.mli @@ -26,6 +26,7 @@ val run_test_against_mutant: ('a -> 'b) -> ('a * 'b) -> bool (** Running mutation tests on a student's test suite. For testing a function called [foo], the student's tests should be in a variable called [foo_tests]. + This module needs to be instantiated with an instance of Test_lib, which is available to the grader code: @@ -45,26 +46,44 @@ val run_test_against_mutant: ('a -> 'b) -> ('a * 'b) -> bool The optional argument [~points] specifies how many points should be given for each mutant exposed by the test suite. + If [test_student_soln] is [true] (as it is by default), + also runs the student's test suite against the student's own + implementation and reports the results. *) module type S = sig val test_unit_tests_1: ?points: int -> + ?test_student_soln: bool -> ('a -> 'b) Ty.ty -> string -> ('a -> 'b) mutant list -> Learnocaml_report.t val test_unit_tests_2: ?points: int -> + ?test_student_soln: bool -> ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) mutant list -> Learnocaml_report.t val test_unit_tests_3: ?points: int -> + ?test_student_soln: bool -> ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd) mutant list -> Learnocaml_report.t val test_unit_tests_4: ?points: int -> + ?test_student_soln: bool -> ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd -> 'e) mutant list -> Learnocaml_report.t + + (* To be called on a report returned by one of the above 4 functions, + for checking whether the student passed or failed mutation testing. + The [Learnocaml_report.result] function is not sufficient for + checking this since a report will register as a failure if the + student's implementation does not pass all of their own tests, even + if the student did pass mutation testing. + If this function is called on a report that did not result from + one of the above 4 functions, the result is undefined. + *) + val passed_mutation_testing: Learnocaml_report.t -> bool end module Make (Test_lib: Test_lib.S) : S From 807b6023ecb4689c432d51686a4023a6f72b8494 Mon Sep 17 00:00:00 2001 From: Aliya Hameer Date: Sun, 11 Aug 2019 16:23:12 -0400 Subject: [PATCH 4/7] Mutation testing: allow custom output comparison --- src/grader/mutation_test.ml | 74 +++++++++++++++++++++++++----------- src/grader/mutation_test.mli | 31 ++++++++++++--- 2 files changed, 78 insertions(+), 27 deletions(-) diff --git a/src/grader/mutation_test.ml b/src/grader/mutation_test.ml index 4417bc7c1..66445be77 100644 --- a/src/grader/mutation_test.ml +++ b/src/grader/mutation_test.ml @@ -7,15 +7,15 @@ type 'a test_result = type 'a mutant = string * 'a -let run_test_against f (input, expected) = +let run_test_against ?(compare = (=)) f (input, expected) = try let output = f input in - if output = expected then Pass + if compare output expected then Pass else Fail output with exn -> Err exn -let run_test_against_mutant f (input, expected) = - match run_test_against f (input, expected) with +let run_test_against_mutant ?(compare = (=)) f (input, expected) = + match run_test_against ~compare f (input, expected) with | Pass -> false | _ -> true @@ -29,14 +29,17 @@ module type S = sig val test_unit_tests_1: ?points: int -> ?test_student_soln: bool -> + ?test: ('b -> 'b -> bool) -> ('a -> 'b) Ty.ty -> string -> ('a -> 'b) mutant list -> Learnocaml_report.t val test_unit_tests_2: ?points: int -> ?test_student_soln: bool -> + ?test: ('c -> 'c -> bool) -> ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) mutant list -> Learnocaml_report.t val test_unit_tests_3: ?points: int -> ?test_student_soln: bool -> + ?test: ('d -> 'd -> bool) -> ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd) mutant list @@ -44,6 +47,7 @@ module type S = sig val test_unit_tests_4: ?points: int -> ?test_student_soln: bool -> + ?test: ('e -> 'e -> bool) -> ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd -> 'e) mutant list @@ -59,8 +63,8 @@ module Make (Test_lib: Test_lib.S) : S = struct Format.asprintf "%a" typed_printer let string_of_exn = typed_printer [%ty: exn] - let test_against_mutant ~points (name, mut) num tests = - let result = List.exists (run_test_against_mutant mut) tests in + let test_against_mutant ~points ~compare (name, mut) num tests = + let result = List.exists (run_test_against_mutant ~compare mut) tests in if result then Message ([Text "Your tests successfully revealed the bug in implementation"; @@ -73,10 +77,13 @@ module Make (Test_lib: Test_lib.S) : S = struct ([Text "Your tests did not expose the bug in implementation"; Text num], Failure) - let test_against_fn ?(show_output=false) f printer out_printer (input, expected) = + let test_against_fn + ~compare + ?(show_output=false) + f printer out_printer (input, expected) = let msg = Message ([Text "Running test"; Code (printer input)], Informative) in let expected_str = out_printer expected in - let result = run_test_against f (input, expected) in + let result = run_test_against ~compare f (input, expected) in let report = match result with | Pass -> [Message ([Text "Test passed with output"; @@ -103,10 +110,13 @@ module Make (Test_lib: Test_lib.S) : S = struct let mutation_header = "...against our buggy implementations" let stud_header = "...against your implementation" - let test_against_mutants ~points muts tests = + let test_against_mutants ~points ~compare muts tests = let string_of_num x = "#" ^ (string_of_int x) in let test_against_mutant_i i mut = - test_against_mutant ~points mut (string_of_num (succ i)) tests + test_against_mutant + ~points + ~compare + mut (string_of_num (succ i)) tests in List.mapi test_against_mutant_i muts @@ -154,14 +164,14 @@ module Make (Test_lib: Test_lib.S) : S = struct let append_map f l = List.fold_right (fun x acc -> (f x) @ acc) l [] - let test_soln_report soln printer out_printer tests = + let test_soln_report ~compare soln printer out_printer tests = match soln with | Unbound report -> soln_not_found_msg :: report | Found soln -> - let tester = test_against_fn soln printer out_printer in + let tester = test_against_fn ~compare soln printer out_printer in append_map tester tests - let test_stud_section stud printer out_printer tests = + let test_stud_section ~compare stud printer out_printer tests = match stud with | None -> [] | Some lookup -> @@ -170,13 +180,16 @@ module Make (Test_lib: Test_lib.S) : S = struct | Unbound report -> report | Found stud -> let tester = - test_against_fn ~show_output: true stud printer out_printer + test_against_fn + ~compare + ~show_output: true + stud printer out_printer in append_map tester tests in [Section ([Text stud_header], stud_report)] - let test ~points test_ty printer out_printer name soln stud muts = + let test ~points ~compare test_ty printer out_printer name soln stud muts = let test_name = name ^ "_tests" in let report = test_variable_property test_ty test_name @@ @@ -184,11 +197,15 @@ module Make (Test_lib: Test_lib.S) : S = struct if List.length tests = 0 then no_test_cases_report else - let soln_report = test_soln_report soln printer out_printer tests in - let stud_section = test_stud_section stud printer out_printer tests in + let soln_report = + test_soln_report ~compare soln printer out_printer tests + in + let stud_section = + test_stud_section ~compare stud printer out_printer tests + in let maybe_mut_report = if snd (Learnocaml_report.result soln_report) then None - else Some (test_against_mutants ~points muts tests) + else Some (test_against_mutants ~points ~compare muts tests) in test_report soln_report stud_section maybe_mut_report in @@ -203,6 +220,7 @@ module Make (Test_lib: Test_lib.S) : S = struct let test_unit_tests_1 ?(points = 1) ?(test_student_soln = true) + ?test:(compare = (=)) ty name muts = let (domain, range) = Ty.domains ty in let test_ty = Ty.lst (Ty.pair2 domain range) in @@ -215,11 +233,12 @@ module Make (Test_lib: Test_lib.S) : S = struct Some (process_lookup (fun x -> x) lookup_student ty name) else None in - test ~points test_ty printer out_printer name soln stud muts + test ~points ~compare test_ty printer out_printer name soln stud muts let test_unit_tests_2 ?(points = 1) ?(test_student_soln = true) + ?test:(compare = (=)) ty name muts = let (dom1, rng) = Ty.domains ty in let (dom2, range) = Ty.domains rng in @@ -237,11 +256,15 @@ module Make (Test_lib: Test_lib.S) : S = struct Some (process_lookup uncurry2 lookup_student ty name) else None in - test ~points test_ty printer out_printer name soln stud muts + test + ~points + ~compare + test_ty printer out_printer name soln stud muts let test_unit_tests_3 ?(points = 1) ?(test_student_soln = true) + ?test:(compare = (=)) ty name muts = let (dom1, rng1) = Ty.domains ty in let (dom2, rng2) = Ty.domains rng1 in @@ -265,11 +288,15 @@ module Make (Test_lib: Test_lib.S) : S = struct Some (process_lookup uncurry3 lookup_student ty name) else None in - test ~points test_ty printer out_printer name soln stud muts + test + ~points + ~compare + test_ty printer out_printer name soln stud muts let test_unit_tests_4 ?(points = 1) ?(test_student_soln = true) + ?test:(compare = (=)) ty name muts = let (dom1, rng1) = Ty.domains ty in let (dom2, rng2) = Ty.domains rng1 in @@ -296,6 +323,9 @@ module Make (Test_lib: Test_lib.S) : S = struct Some (process_lookup uncurry4 lookup_student ty name) else None in - test ~points test_ty printer out_printer name soln stud muts + test + ~points + ~compare + test_ty printer out_printer name soln stud muts end diff --git a/src/grader/mutation_test.mli b/src/grader/mutation_test.mli index c30dcf197..9ad088a84 100644 --- a/src/grader/mutation_test.mli +++ b/src/grader/mutation_test.mli @@ -11,24 +11,38 @@ type 'a test_result = | Fail of 'a | Err of exn +(** A mutant is a pair of a string describing the mutant and the + mutant function itself. +*) type 'a mutant = string * 'a -(** Run a test (a pair of input and expected output) on a function. *) -val run_test_against: ('a -> 'b) -> ('a * 'b) -> 'b test_result +(** Run a test (a pair of input and expected output) on a function. + The [compare] parameter specifies a comparison function for + comparing the expected and actual outputs, and defaults to + structural equality ([(=)]). +*) +val run_test_against: + ?compare: ('b -> 'b -> bool) -> + ('a -> 'b) -> ('a * 'b) -> 'b test_result (** Run a test (a pair of input and expected output) on a mutant. Returns true if the mutant *fails* the test, either by deviating from the expected output or by raising an error. Returns false if the mutant *passes* the test. + The [compare] parameter specifies a comparison function for + comparing the expected and actual outputs, and defaults to + structural equality ([(=)]). *) -val run_test_against_mutant: ('a -> 'b) -> ('a * 'b) -> bool +val run_test_against_mutant: + ?compare: ('b -> 'b -> bool) -> + ('a -> 'b) -> ('a * 'b) -> bool (** Running mutation tests on a student's test suite. - For testing a function called [foo], the student's tests should + For testing a function call [foo], the student's tests should be in a variable called [foo_tests]. This module needs to be instantiated with an instance of - Test_lib, which is available to the grader code: + [Test_lib], which is available to the grader code: {[ module M = Mutation_test.Make (Test_lib) @@ -49,19 +63,25 @@ val run_test_against_mutant: ('a -> 'b) -> ('a * 'b) -> bool If [test_student_soln] is [true] (as it is by default), also runs the student's test suite against the student's own implementation and reports the results. + The [test] parameter specifies a comparison function for the + expected and actual outputs, and defaults to structural + equality ([(=)]). *) module type S = sig val test_unit_tests_1: ?points: int -> ?test_student_soln: bool -> + ?test: ('b -> 'b -> bool) -> ('a -> 'b) Ty.ty -> string -> ('a -> 'b) mutant list -> Learnocaml_report.t val test_unit_tests_2: ?points: int -> ?test_student_soln: bool -> + ?test: ('c -> 'c -> bool) -> ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) mutant list -> Learnocaml_report.t val test_unit_tests_3: ?points: int -> ?test_student_soln: bool -> + ?test: ('d -> 'd -> bool) -> ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd) mutant list @@ -69,6 +89,7 @@ module type S = sig val test_unit_tests_4: ?points: int -> ?test_student_soln: bool -> + ?test: ('e -> 'e -> bool) -> ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd -> 'e) mutant list From e90d70ff279588dd273851ce0aed660a037e5d47 Mon Sep 17 00:00:00 2001 From: Aliya Hameer Date: Sun, 11 Aug 2019 18:54:22 -0400 Subject: [PATCH 5/7] Temporary: use Important instead of Success 0 This can be reverted if ocaml-sf/learn-ocaml#300 is fixed. --- src/grader/mutation_test.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/grader/mutation_test.ml b/src/grader/mutation_test.ml index 66445be77..1f103ca88 100644 --- a/src/grader/mutation_test.ml +++ b/src/grader/mutation_test.ml @@ -88,7 +88,7 @@ module Make (Test_lib: Test_lib.S) : S = struct match result with | Pass -> [Message ([Text "Test passed with output"; Code expected_str], - Success 0)] + Important)] | Fail out -> [Message ([Text "Test failed: expected output"; Code expected_str; From f09c5dc2b2d9bc8bda45be300f83784b6ab9fe99 Mon Sep 17 00:00:00 2001 From: Aliya Hameer Date: Fri, 16 Aug 2019 17:18:18 -0400 Subject: [PATCH 6/7] Mutation testing: specify points per mutant --- demo-repository/exercises/demo/test.ml | 8 +++--- src/grader/mutation_test.ml | 40 +++++++++----------------- src/grader/mutation_test.mli | 20 ++++++------- 3 files changed, 27 insertions(+), 41 deletions(-) diff --git a/demo-repository/exercises/demo/test.ml b/demo-repository/exercises/demo/test.ml index ad6123f4b..58ef13e0c 100644 --- a/demo-repository/exercises/demo/test.ml +++ b/demo-repository/exercises/demo/test.ml @@ -11,7 +11,7 @@ let test_plus () = @ test_unit_tests_2 [%ty : int -> int -> int ] "plus" - [ ("Subtracts instead of adding", fun x y -> x - y) ] + [ ("Subtracts instead of adding", 1, fun x y -> x - y) ] let test_minus () = test_function_2_against_solution @@ -20,7 +20,7 @@ let test_minus () = @ test_unit_tests_2 [%ty : int -> int -> int ] "minus" - [ ("Adds instead of subtracting", fun x y -> x + y) ] + [ ("Adds instead of subtracting", 1, fun x y -> x + y) ] let test_times () = test_function_2_against_solution @@ -29,7 +29,7 @@ let test_times () = @ test_unit_tests_2 [%ty: int -> int -> int ] "times" - [ ("Divides instead of multiplying", fun x y -> x / y) ] + [ ("Divides instead of multiplying", 1, fun x y -> x / y) ] let test_divide () = test_function_2_against_solution @@ -38,7 +38,7 @@ let test_divide () = @ test_unit_tests_2 [%ty : int -> int -> int ] "divide" - [ ("Multiplies instead of dividing", fun x y -> x * y) ] + [ ("Multiplies instead of dividing", 1, fun x y -> x * y) ] let () = set_result @@ diff --git a/src/grader/mutation_test.ml b/src/grader/mutation_test.ml index 1f103ca88..ccc22dcbd 100644 --- a/src/grader/mutation_test.ml +++ b/src/grader/mutation_test.ml @@ -5,7 +5,7 @@ type 'a test_result = | Fail of 'a | Err of exn -type 'a mutant = string * 'a +type 'a mutant_info = string * int * 'a let run_test_against ?(compare = (=)) f (input, expected) = try @@ -23,34 +23,30 @@ let run_test_against_mutant ?(compare = (=)) f (input, expected) = let uncurry2 f = fun (x, y) -> f x y let uncurry3 f = fun (x, y, z) -> f x y z let uncurry4 f = fun (x, y, z, w) -> f x y z w -let map_snd f = fun (x, y) -> (x, f y) +let map_third f = fun (x, y, z) -> (x, y, f z) module type S = sig val test_unit_tests_1: - ?points: int -> ?test_student_soln: bool -> ?test: ('b -> 'b -> bool) -> - ('a -> 'b) Ty.ty -> string -> ('a -> 'b) mutant list -> Learnocaml_report.t + ('a -> 'b) Ty.ty -> string -> ('a -> 'b) mutant_info list -> Learnocaml_report.t val test_unit_tests_2: - ?points: int -> ?test_student_soln: bool -> ?test: ('c -> 'c -> bool) -> - ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) mutant list -> Learnocaml_report.t + ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) mutant_info list -> Learnocaml_report.t val test_unit_tests_3: - ?points: int -> ?test_student_soln: bool -> ?test: ('d -> 'd -> bool) -> ('a -> 'b -> 'c -> 'd) Ty.ty -> string - -> ('a -> 'b -> 'c -> 'd) mutant list + -> ('a -> 'b -> 'c -> 'd) mutant_info list -> Learnocaml_report.t val test_unit_tests_4: - ?points: int -> ?test_student_soln: bool -> ?test: ('e -> 'e -> bool) -> ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string - -> ('a -> 'b -> 'c -> 'd -> 'e) mutant list + -> ('a -> 'b -> 'c -> 'd -> 'e) mutant_info list -> Learnocaml_report.t val passed_mutation_testing: Learnocaml_report.t -> bool end @@ -63,7 +59,7 @@ module Make (Test_lib: Test_lib.S) : S = struct Format.asprintf "%a" typed_printer let string_of_exn = typed_printer [%ty: exn] - let test_against_mutant ~points ~compare (name, mut) num tests = + let test_against_mutant ~compare (name, points, mut) num tests = let result = List.exists (run_test_against_mutant ~compare mut) tests in if result then Message @@ -110,11 +106,10 @@ module Make (Test_lib: Test_lib.S) : S = struct let mutation_header = "...against our buggy implementations" let stud_header = "...against your implementation" - let test_against_mutants ~points ~compare muts tests = + let test_against_mutants ~compare muts tests = let string_of_num x = "#" ^ (string_of_int x) in let test_against_mutant_i i mut = test_against_mutant - ~points ~compare mut (string_of_num (succ i)) tests in @@ -189,7 +184,7 @@ module Make (Test_lib: Test_lib.S) : S = struct in [Section ([Text stud_header], stud_report)] - let test ~points ~compare test_ty printer out_printer name soln stud muts = + let test ~compare test_ty printer out_printer name soln stud muts = let test_name = name ^ "_tests" in let report = test_variable_property test_ty test_name @@ @@ -205,7 +200,7 @@ module Make (Test_lib: Test_lib.S) : S = struct in let maybe_mut_report = if snd (Learnocaml_report.result soln_report) then None - else Some (test_against_mutants ~points ~compare muts tests) + else Some (test_against_mutants ~compare muts tests) in test_report soln_report stud_section maybe_mut_report in @@ -218,7 +213,6 @@ module Make (Test_lib: Test_lib.S) : S = struct let test_unit_tests_1 - ?(points = 1) ?(test_student_soln = true) ?test:(compare = (=)) ty name muts = @@ -233,10 +227,9 @@ module Make (Test_lib: Test_lib.S) : S = struct Some (process_lookup (fun x -> x) lookup_student ty name) else None in - test ~points ~compare test_ty printer out_printer name soln stud muts + test ~compare test_ty printer out_printer name soln stud muts let test_unit_tests_2 - ?(points = 1) ?(test_student_soln = true) ?test:(compare = (=)) ty name muts = @@ -249,7 +242,7 @@ module Make (Test_lib: Test_lib.S) : S = struct name ^ " " ^ (in1_printer in1) ^ " " ^ (in2_printer in2) in let out_printer = typed_printer range in - let muts = List.map (map_snd uncurry2) muts in + let muts = List.map (map_third uncurry2) muts in let soln = process_lookup uncurry2 lookup_solution ty name in let stud = if test_student_soln then @@ -257,12 +250,10 @@ module Make (Test_lib: Test_lib.S) : S = struct else None in test - ~points ~compare test_ty printer out_printer name soln stud muts let test_unit_tests_3 - ?(points = 1) ?(test_student_soln = true) ?test:(compare = (=)) ty name muts = @@ -281,7 +272,7 @@ module Make (Test_lib: Test_lib.S) : S = struct ^ " " ^ (in3_printer in3) in let out_printer = typed_printer range in - let muts = List.map (map_snd uncurry3) muts in + let muts = List.map (map_third uncurry3) muts in let soln = process_lookup uncurry3 lookup_solution ty name in let stud = if test_student_soln then @@ -289,12 +280,10 @@ module Make (Test_lib: Test_lib.S) : S = struct else None in test - ~points ~compare test_ty printer out_printer name soln stud muts let test_unit_tests_4 - ?(points = 1) ?(test_student_soln = true) ?test:(compare = (=)) ty name muts = @@ -316,7 +305,7 @@ module Make (Test_lib: Test_lib.S) : S = struct ^ " " ^ (in4_printer in4) in let out_printer = typed_printer range in - let muts = List.map (map_snd uncurry4) muts in + let muts = List.map (map_third uncurry4) muts in let soln = process_lookup uncurry4 lookup_solution ty name in let stud = if test_student_soln then @@ -324,7 +313,6 @@ module Make (Test_lib: Test_lib.S) : S = struct else None in test - ~points ~compare test_ty printer out_printer name soln stud muts diff --git a/src/grader/mutation_test.mli b/src/grader/mutation_test.mli index 9ad088a84..7391b283a 100644 --- a/src/grader/mutation_test.mli +++ b/src/grader/mutation_test.mli @@ -11,10 +11,12 @@ type 'a test_result = | Fail of 'a | Err of exn -(** A mutant is a pair of a string describing the mutant and the - mutant function itself. +(** The information about a mutant is made up of: + - A name describing the bug in the mutant function + - The number of points to be awarded for exposing the bug + - The mutant function itself. *) -type 'a mutant = string * 'a +type 'a mutant_info = string * int * 'a (** Run a test (a pair of input and expected output) on a function. The [compare] parameter specifies a comparison function for @@ -69,30 +71,26 @@ val run_test_against_mutant: *) module type S = sig val test_unit_tests_1: - ?points: int -> ?test_student_soln: bool -> ?test: ('b -> 'b -> bool) -> - ('a -> 'b) Ty.ty -> string -> ('a -> 'b) mutant list -> Learnocaml_report.t + ('a -> 'b) Ty.ty -> string -> ('a -> 'b) mutant_info list -> Learnocaml_report.t val test_unit_tests_2: - ?points: int -> ?test_student_soln: bool -> ?test: ('c -> 'c -> bool) -> - ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) mutant list -> Learnocaml_report.t + ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) mutant_info list -> Learnocaml_report.t val test_unit_tests_3: - ?points: int -> ?test_student_soln: bool -> ?test: ('d -> 'd -> bool) -> ('a -> 'b -> 'c -> 'd) Ty.ty -> string - -> ('a -> 'b -> 'c -> 'd) mutant list + -> ('a -> 'b -> 'c -> 'd) mutant_info list -> Learnocaml_report.t val test_unit_tests_4: - ?points: int -> ?test_student_soln: bool -> ?test: ('e -> 'e -> bool) -> ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string - -> ('a -> 'b -> 'c -> 'd -> 'e) mutant list + -> ('a -> 'b -> 'c -> 'd -> 'e) mutant_info list -> Learnocaml_report.t (* To be called on a report returned by one of the above 4 functions, From a5a7d3a7d4a29770a34e3006105aac795bf24742 Mon Sep 17 00:00:00 2001 From: Aliya Hameer Date: Wed, 28 Aug 2019 17:56:25 -0400 Subject: [PATCH 7/7] Mutation testing: reorganization and documentation --- src/grader/mutation_test.ml | 29 +++++++------- src/grader/mutation_test.mli | 74 +++++++++++++++++++----------------- 2 files changed, 55 insertions(+), 48 deletions(-) diff --git a/src/grader/mutation_test.ml b/src/grader/mutation_test.ml index ccc22dcbd..3622b2499 100644 --- a/src/grader/mutation_test.ml +++ b/src/grader/mutation_test.ml @@ -7,25 +7,15 @@ type 'a test_result = type 'a mutant_info = string * int * 'a -let run_test_against ?(compare = (=)) f (input, expected) = - try - let output = f input in - if compare output expected then Pass - else Fail output - with exn -> Err exn - -let run_test_against_mutant ?(compare = (=)) f (input, expected) = - match run_test_against ~compare f (input, expected) with - | Pass -> false - | _ -> true - - let uncurry2 f = fun (x, y) -> f x y let uncurry3 f = fun (x, y, z) -> f x y z let uncurry4 f = fun (x, y, z, w) -> f x y z w let map_third f = fun (x, y, z) -> (x, y, f z) module type S = sig + val run_test_against_mutant: + ?compare: ('b -> 'b -> bool) -> + ('a -> 'b) -> ('a * 'b) -> bool val test_unit_tests_1: ?test_student_soln: bool -> ?test: ('b -> 'b -> bool) -> @@ -54,6 +44,19 @@ end module Make (Test_lib: Test_lib.S) : S = struct open Test_lib + let run_test_against ?(compare = (=)) f (input, expected) = + try + let run_f () = f input in + let output = run_timeout run_f in + if compare output expected then Pass + else Fail output + with exn -> Err exn + + let run_test_against_mutant ?(compare = (=)) f (input, expected) = + match run_test_against ~compare f (input, expected) with + | Pass -> false + | _ -> true + let typed_printer ty = let typed_printer ppf v = Introspection.print_value ppf v ty in Format.asprintf "%a" typed_printer diff --git a/src/grader/mutation_test.mli b/src/grader/mutation_test.mli index 7391b283a..d6e81d044 100644 --- a/src/grader/mutation_test.mli +++ b/src/grader/mutation_test.mli @@ -6,10 +6,20 @@ * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) -type 'a test_result = - | Pass - | Fail of 'a - | Err of exn +(* This module provides functions for automatically grading + a student's unit tests using *mutation testing*. + + A student's tests for a function [foo] are run against several + *mutants* (buggy implementations of [foo]). The student then + receives a grade based on how many mutants *failed* at least + one of their tests, i.e. how many buggy implementations were + exposed as buggy by their test suite. + + Mutants are written by the instructor, and ideally should + be chosen to emphasize test cases that students should be + testing for. One could think of mutants as "test cases for + the tests". +*) (** The information about a mutant is made up of: - A name describing the bug in the mutant function @@ -18,30 +28,9 @@ type 'a test_result = *) type 'a mutant_info = string * int * 'a -(** Run a test (a pair of input and expected output) on a function. - The [compare] parameter specifies a comparison function for - comparing the expected and actual outputs, and defaults to - structural equality ([(=)]). -*) -val run_test_against: - ?compare: ('b -> 'b -> bool) -> - ('a -> 'b) -> ('a * 'b) -> 'b test_result - -(** Run a test (a pair of input and expected output) on a mutant. - Returns true if the mutant *fails* the test, either by deviating - from the expected output or by raising an error. - Returns false if the mutant *passes* the test. - The [compare] parameter specifies a comparison function for - comparing the expected and actual outputs, and defaults to - structural equality ([(=)]). -*) -val run_test_against_mutant: - ?compare: ('b -> 'b -> bool) -> - ('a -> 'b) -> ('a * 'b) -> bool - (** Running mutation tests on a student's test suite. - For testing a function call [foo], the student's tests should - be in a variable called [foo_tests]. + For testing a function called [foo], the student's tests + should be in a variable called [foo_tests]. This module needs to be instantiated with an instance of [Test_lib], which is available to the grader code: @@ -70,6 +59,20 @@ val run_test_against_mutant: equality ([(=)]). *) module type S = sig + + (** Run a test (a pair of input and expected output) on a mutant + function. + Returns true if the mutant *fails* the test, either by deviating + from the expected output or by raising an error. + Returns false if the mutant *passes* the test. + The [compare] parameter specifies a comparison function for + comparing the expected and actual outputs, and defaults to + structural equality ([(=)]). + *) + val run_test_against_mutant: + ?compare: ('b -> 'b -> bool) -> + ('a -> 'b) -> ('a * 'b) -> bool + val test_unit_tests_1: ?test_student_soln: bool -> ?test: ('b -> 'b -> bool) -> @@ -93,14 +96,15 @@ module type S = sig -> ('a -> 'b -> 'c -> 'd -> 'e) mutant_info list -> Learnocaml_report.t - (* To be called on a report returned by one of the above 4 functions, - for checking whether the student passed or failed mutation testing. - The [Learnocaml_report.result] function is not sufficient for - checking this since a report will register as a failure if the - student's implementation does not pass all of their own tests, even - if the student did pass mutation testing. - If this function is called on a report that did not result from - one of the above 4 functions, the result is undefined. + (** To be called on a report returned by one of the + [test_unit_tests_] functions, + for checking whether the student passed or failed mutation testing. + The [Learnocaml_report.result] function is not sufficient for + checking this since a report will register as a failure if the + student's implementation does not pass all of their own tests, even + if the student did pass mutation testing. + If this function is called on a report that did not result from + one of the above 4 functions, the result is undefined. *) val passed_mutation_testing: Learnocaml_report.t -> bool end