├── .gitattributes ├── .github ├── dependabot.yml └── workflows │ └── ci.yml ├── .gitignore ├── CHANGES.md ├── LICENSE.md ├── Makefile ├── README.md ├── demo.gif ├── dune-project ├── dune-workspace ├── examples ├── testproj-1-module │ ├── Makefile │ ├── dune │ ├── dune-project │ ├── dune-workspace │ ├── lib.ml │ ├── main.ml │ └── ounittest.ml └── testproj-2-modules │ ├── Makefile │ ├── dune │ ├── dune-project │ ├── dune-workspace │ ├── src │ ├── dune │ ├── lib1.ml │ ├── lib2.ml │ └── main.ml │ └── test │ ├── dune │ └── ounittest.ml ├── mutaml.opam ├── mutaml.opam.template ├── src ├── common │ ├── dune │ └── mutaml_common.ml ├── ppx │ ├── RS.ml │ ├── RS.mli │ ├── dune │ ├── entry.ml │ └── mutaml_ppx.ml ├── report │ ├── dune │ └── report.ml └── runner │ ├── dune │ └── runner.ml └── test ├── dune ├── filter_dune_build.sh ├── instrumentation-tests ├── arith.t ├── assert.t ├── attributes.t ├── bool.t ├── function-merge-consecutive.t ├── function-omit-case.t ├── gadts.t ├── ifthenelse.t ├── match-omit-case.t ├── match.t ├── notes.md ├── open_module.t ├── ppx-args.t ├── records.t ├── sequence.t └── simple_print.t ├── issue-attributes.t └── run.t ├── issue-newlines.t └── run.t ├── issue-pattern-match.t └── run.t ├── issue-stdlib-equal.t └── run.t ├── negative-tests ├── ppx-negtests.t ├── report-negtests.t └── runner-negtests.t ├── testproj-1-module.t ├── lib.ml ├── main.ml ├── ounittest.ml └── run.t ├── testproj-2-modules.t ├── run.t ├── src │ ├── dune │ ├── lib1.ml │ ├── lib2.ml │ └── main.ml └── test │ ├── dune │ └── ounittest.ml └── write_dune_files.sh /.gitattributes: -------------------------------------------------------------------------------- 1 | *.ml* text eol=lf linguist-language=OCaml 2 | *.rst text eol=lf 3 | *.c text eol=lf 4 | *.t text eol=lf -linguist-detectable 5 | *.ps1 text working-tree-encoding=UTF-16 eol=crlf 6 | dune text eol=lf 7 | dune.inc text eol=lf 8 | .gitignore text eol=lf 9 | .gitattributes text eol=lf 10 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | updates: 3 | - package-ecosystem: "github-actions" 4 | directory: "/" 5 | schedule: 6 | interval: "weekly" 7 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: Main CI workflow 2 | 3 | on: 4 | pull_request: 5 | push: 6 | 7 | jobs: 8 | build: 9 | strategy: 10 | fail-fast: false 11 | matrix: 12 | os: 13 | - macos-latest 14 | - ubuntu-latest 15 | 16 | ocaml-compiler: 17 | # - 4.08.x 18 | # - 4.09.x 19 | # - 4.10.x 20 | # - 4.11.x 21 | - 4.12.x 22 | # - 4.13.x 23 | - 4.14.x 24 | - 5.3.x 25 | 26 | runs-on: ${{ matrix.os }} 27 | 28 | steps: 29 | - name: Checkout code 30 | uses: actions/checkout@v4 31 | 32 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 33 | uses: ocaml/setup-ocaml@v3 34 | with: 35 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 36 | 37 | - name: Install GNU bash, sed, diff w/color, and setup timeout 38 | if: ${{ matrix.os == 'macos-latest' }} 39 | run: | 40 | brew update 41 | brew install bash 42 | brew install gnu-sed 43 | echo "$(brew --prefix)/opt/gnu-sed/libexec/gnubin" >> $GITHUB_PATH 44 | brew install diffutils 45 | brew install coreutils 46 | echo "$(brew --prefix)/opt/coreutils/libexec/gnubin" >> $GITHUB_PATH 47 | echo "$PATH" 48 | echo `which timeout` 49 | # ls /usr/local/opt/coreutils/libexec/gnubin 50 | 51 | - run: opam install . --deps-only --with-test 52 | 53 | - run: opam exec -- dune build @all 54 | 55 | - run: opam exec -- dune build @runtest 56 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build/ 2 | _opam/ 3 | runner.exe 4 | report.exe 5 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | Next release 2 | ------------ 3 | 4 | - ... 5 | 6 | 0.3 7 | --- 8 | 9 | - Avoid mutations in attribute parameters #29 10 | - Avoid polymorphic equality which is incompatible with Core #30 11 | 12 | 0.2 13 | --- 14 | 15 | - Add support for ppxlib.0.28 and above #27 16 | - Avoid triggering 2 mutations of a pattern incl. a when-clause 17 | causing a redundant sub-pattern warning #22, #23 18 | 19 | 0.1 20 | --- 21 | 22 | - Initial opam release of `mutaml` 23 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | BSD 2-Clause License 2 | 3 | Copyright (c) 2021, Jan Midtgaard 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 17 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 18 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 19 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 20 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 21 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 22 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 23 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 24 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 25 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: test 2 | all: 3 | dune build 4 | 5 | test: 6 | dune test 7 | 8 | clean: 9 | rm -f *~ src/*~ src/common/*~ src/ppx/*~ src/report/*~ src/runner/*~ 10 | rm -f test/*~ test/instrumentation-tests.t/*~ test/negative-tests/*~ 11 | rm -f test/testproj-1-module.t/*~ test/testproj-2-modules.t/*~ output*.txt 12 | dune clean 13 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Mutaml: A Mutation Tester for OCaml [![Main CI workflow](https://github.com/jmid/mutaml/actions/workflows/ci.yml/badge.svg)](https://github.com/jmid/mutaml/actions/workflows/ci.yml) 2 | =============================================== 3 | 4 | Mutaml is a mutation testing tool for OCaml. 5 | Briefly, that means Mutaml tries to change your code randomly to see 6 | if the changes are caught by your tests. 7 | 8 | ![](demo.gif) 9 | 10 | In more detail: [Mutation testing](https://en.wikipedia.org/wiki/Mutation_testing) is 11 | a form of fault injection used to assess the quality of a program's 12 | test suite. Mutation testing works by repeatedly making small, breaking 13 | changes to a program's text, such as turning a `+` into `-`, negating 14 | the condition of an `if-then-else`, ..., and subsequently rerunning 15 | the test suite to see if each such 'mutant program' is 'killed' 16 | (caught) by one or more tests in the test suite. By finding examples of 17 | uncaught wrong behaviour, mutation testing can thereby reveal 18 | limitations of an existing test suite and indirectly suggest 19 | improvements. 20 | 21 | Since OCaml already prevents many potential programming errors at compile 22 | time due to its strong type system, pattern-match compiler warnings, etc. Mutaml 23 | favors mutations that 24 | - preserve typing and 25 | - would not be caught statically, e.g., changes in the values computed. 26 | 27 | Mutaml consists of: 28 | 29 | - a [`ppxlib`](https://github.com/ocaml-ppx/ppxlib)-preprocessor that 30 | first transforms the program under test. 31 | - `mutaml-runner` that loops through a range of possible program mutations, 32 | and saves the output from running the test suite on each of the mutants 33 | - `mutaml-report` that prints a test report to the console. 34 | 35 | 36 | Installation: 37 | ------------- 38 | 39 | You can install `mutaml` with a single `opam` command: 40 | 41 | ``` 42 | $ opam install mutaml 43 | 44 | ``` 45 | 46 | Alternatively, you can also install it from a clone of the repository: 47 | 48 | ``` 49 | $ git clone https://github.com/jmid/mutaml.git 50 | $ cd mutaml 51 | $ opam install . 52 | ``` 53 | 54 | 55 | Instructions: 56 | ------------- 57 | 58 | How you can use `mutaml` depends on your project's build setup. 59 | For now it has only been tested with `dune`, but it should work 60 | with other build systems supporting an explicit two-staged build 61 | process. 62 | 63 | 64 | ### Using Mutaml with `dune` 65 | 66 | 1. Mark the target code for instrumentation in your `dune` file(s): 67 | ``` 68 | (library 69 | (public_name your_library) 70 | (instrumentation (backend mutaml))) 71 | ``` 72 | Using `dune`'s [`instrumentation` stanza](https://dune.readthedocs.io/en/stable/instrumentation.html), your project's code is 73 | only instrumented when you pass the `--instrument-with mutaml` 74 | option. 75 | 76 | 77 | 2. Compile your test code with `mutaml` instrumentation enabled: 78 | ``` 79 | $ dune build test --instrument-with mutaml 80 | ``` 81 | assuming you have a `test/mytests.ml` test driver. 82 | This creates/overwrites an individual `lib.muts` file for each 83 | instrumented `lib.ml` file and an overview file 84 | `mutaml-mut-files.txt` listing them. 85 | These files are written to `dune`'s current build context. 86 | 87 | 88 | 3. Start `mutaml-runner`, passing the name of the test executable to run: 89 | ``` 90 | $ mutaml-runner _build/default/test/mytests.exe 91 | ``` 92 | This reads from the files written in step 2. Running the command also 93 | creates/overwrites the file `mutaml-report.json`. 94 | You can also pass a command that runs the executable through `dune` 95 | if you prefer: 96 | ``` 97 | $ mutaml-runner "dune exec --no-build test/mytests.exe" 98 | ``` 99 | 100 | 4. Generate a report, optionally passing the json-file 101 | (`mutaml-report.json`) created above: 102 | ``` 103 | $ mutaml-report 104 | ``` 105 | By default this prints `diff`s for each mutation that flew under 106 | the radar of your test suite. The `diff` output can be suppressed by 107 | passing `--no-diff`. 108 | 109 | 110 | Steps 3 and 4 output a number of additional files. 111 | These are all written to a dedicated directory named `_mutations`. 112 | 113 | 114 | 115 | Instrumentation Options and Environment Variables 116 | ------------------------------------------------- 117 | 118 | The preprocessor's behaviour can be configured through either 119 | environment variables or instrumentation options in the `dune` file: 120 | 121 | - `MUTAML_SEED` - an integer value to seed `mutaml-ppx`'s randomized 122 | mutations (overridden by instrumentation option `-seed`) 123 | - `MUTAML_MUT_RATE` - a integer between 0 and 100 to specify the 124 | mutation frequency (0 means never and 100 means always - overridden 125 | by instrumentation option `-mut-rate`) 126 | - `MUTAML_GADT` - allow only pattern mutations compatible with GADTs 127 | (`true` or `false`, overridden by instrumentation option `-gadt`) 128 | 129 | 130 | For example, the following `dune` file sets all three instrumentation 131 | options: 132 | ``` 133 | (executable 134 | (name test) 135 | (instrumentation (backend mutaml -seed 42 -mut-rate 75 -gadt false)) 136 | ) 137 | ``` 138 | We could achieve the same behaviour by setting three environment 139 | variables: 140 | ```bash 141 | $ export MUTAML_SEED=42 142 | $ export MUTAML_MUT_RATE=75 143 | $ export MUTAML_GADT=false 144 | ``` 145 | If you do both, the values passed as instrumentation options in the 146 | `dune` file take precedence. 147 | 148 | 149 | Runner Options and Environment Variables 150 | ---------------------------------------- 151 | 152 | By default, `mutaml-runner` expects to find the preprocessor's output 153 | files in the default build context `_build/default`. This can be 154 | configured via an environment variable or a command-line option, e.g., 155 | if [instrumentation is enabled via another `dune-workspace` build context](https://dune.readthedocs.io/en/stable/instrumentation.html#enabling-disabling-instrumentation): 156 | 157 | - `MUTAML_BUILD_CONTEXT` - a path prefix string (overridden by 158 | command-line option `--build-context`) 159 | 160 | `mutaml-runner` also repeats test suite runs for all instrumented 161 | `lib.ml` files by default. An option `--muts muts-file` is available 162 | to enable more targeted mutation testing. Running, e.g., 163 | ``` 164 | mutaml-runner --muts lib/lib2.muts _build/default/test/mytests.exe 165 | ``` 166 | will only consider mutations of the corresponding library 167 | `lib/lib2.ml`, which the runner searches for in the build context. 168 | 169 | 170 | Report Options and Environment Variables 171 | ---------------------------------------- 172 | 173 | Currently `mutaml-report` uses `diff --color -u` as its default 174 | command to print `diff`s. It falls back to `diff -u` when the 175 | environment variable `CI` is `true`. The used command can also be 176 | configured with an environment variable: 177 | 178 | - `MUTAML_DIFF_COMMAND` - the command and options to use instead, 179 | e.g. `MUTAML_DIFF_COMMAND="diff -U 5"` will disable colored outputs 180 | and add 5 lines of unified context. Mutaml expects the specified 181 | command to support `--label` options. 182 | 183 | Passing the option `--no-diff` to `mutaml-report` prevents any 184 | mutation `diff`s from being printed. 185 | 186 | 187 | 188 | Status 189 | ------ 190 | 191 | This is an *alpha* release. There are therefore rough edges: 192 | 193 | - Mutaml is designed to avoid repeated recompilation for each 194 | mutation. It does so by writing files during preprocessing which are 195 | later read during the `mutaml-runner` testing loop. As a consequence, 196 | if you attempt to merge steps 2 and 3 above into one step this will not work: 197 | ``` 198 | $ mutaml-runner "dune test --force --instrument-with mutaml" 199 | ``` 200 | The preprocessor in this case only writes the relevant files when 201 | `mutaml-runner` first calls the command, and thus *after* it needs the 202 | information contained in the files... 203 | 204 | - There are [issues to force `dune` to 205 | rebuild](https://github.com/ocaml/dune/issues/4390). This can affect 206 | Mutaml, e.g., in case just an environment variable changed. `dune 207 | clean` is a crude but effective work-around to this issue. 208 | 209 | - The output files to `_build/default` are not registered with `dune`. 210 | This means rerunning steps 2,3,4 above will fail, as the additional 211 | output files in `_build/default` are not cached by `dune` and hence 212 | deleted. Again `dune clean` is a crude but effective work-around. 213 | 214 | - ... 215 | 216 | 217 | Mutations should not introduce compiler errors, be it type errors or 218 | from the pattern-match compiler. If you encounter a situation where 219 | this happens please report it in an issue. 220 | 221 | 222 | Acknowledgements 223 | ---------------- 224 | 225 | Mutaml was developed with support from the [OCaml Software Foundation](https://ocaml-sf.org/). 226 | While developing it, I also benefitted from studying the source code 227 | of [bisect_ppx](https://github.com/aantron/bisect_ppx). 228 | -------------------------------------------------------------------------------- /demo.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jmid/mutaml/983230ac24d5433c1d42e18e97ac0ac70149ca62/demo.gif -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.0) 2 | 3 | (name mutaml) 4 | 5 | (formatting 6 | (enabled_for dune)) 7 | 8 | (generate_opam_files) 9 | 10 | (package 11 | (name mutaml) 12 | (synopsis "A mutation tester for OCaml") 13 | (license "BSD-2-Clause") 14 | (version "0.3") 15 | (description 16 | "\| Mutaml is a mutation testing tool for OCaml. 17 | "\| It uses a ppxlib-based preprocessor to make a series of small 18 | "\| breaking changes to a program's source code and then runs 19 | "\| the program's testsuite for each of them to catch uncaught 20 | "\| misbehaviour. 21 | ) 22 | (source (github jmid/mutaml)) 23 | (documentation "https://github.com/jmid/mutaml") 24 | (authors "Jan Midtgaard ") 25 | (maintainers "Jan Midtgaard ") 26 | (tags ("test" "mutation testing")) 27 | (depends 28 | (ocaml (>= 4.12.0)) 29 | (ppxlib (>= 0.28.0)) 30 | (ppx_yojson_conv (>= 0.14.0)) 31 | stdlib-random 32 | conf-timeout 33 | conf-diffutils 34 | ;; transitive lower versions to avoid CI errors 35 | (ocaml-compiler-libs (>= v0.12.0)) 36 | (ppx_derivers (>= 1.2.1)) 37 | (yojson (>= 2.0.0)) 38 | (ppx_deriving :with-test) 39 | (ounit2 :with-test))) 40 | -------------------------------------------------------------------------------- /dune-workspace: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jmid/mutaml/983230ac24d5433c1d42e18e97ac0ac70149ca62/dune-workspace -------------------------------------------------------------------------------- /examples/testproj-1-module/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: test 2 | test: 3 | dune test 4 | 5 | mutamltest: 6 | dune build ./ounittest.exe --instrument-with mutaml 7 | mutaml-runner "dune exec --no-build ./ounittest.exe" 8 | mutaml-report 9 | 10 | clean: 11 | rm -rf *~ _mutations mutaml-report.json 12 | dune clean 13 | -------------------------------------------------------------------------------- /examples/testproj-1-module/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name lib) 3 | (modules lib) 4 | (libraries stdlib-random.v4) 5 | (instrumentation (backend mutaml))) 6 | 7 | (executable 8 | (name main) 9 | (modules main) 10 | (libraries lib)) 11 | 12 | (test 13 | (name ounittest) 14 | (modules ounittest) 15 | (libraries lib ounit2)) 16 | -------------------------------------------------------------------------------- /examples/testproj-1-module/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.9) 2 | (formatting disabled) 3 | -------------------------------------------------------------------------------- /examples/testproj-1-module/dune-workspace: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jmid/mutaml/983230ac24d5433c1d42e18e97ac0ac70149ca62/examples/testproj-1-module/dune-workspace -------------------------------------------------------------------------------- /examples/testproj-1-module/lib.ml: -------------------------------------------------------------------------------- 1 | module Random = Random4 2 | 3 | let rec fac n = match n with 4 | | 0 -> 1 5 | | _ -> n * fac (n-1) 6 | 7 | let rec sum n = match n with 8 | | 0 -> 0 9 | | _ -> n + sum (n-1) 10 | 11 | let greeting s = "Hello, " ^ s 12 | 13 | (* A Monte Carlo simulation computing a pi-approximation *) 14 | let pi total = 15 | let rec loop n inside = 16 | if n = 0 then 17 | 4. *. (float_of_int inside /. float_of_int total) 18 | else 19 | let x = 1.0 -. Random.float 2.0 in 20 | let y = 1.0 -. Random.float 2.0 in 21 | if x *. x +. y *. y <= 1. 22 | then loop (n-1) (inside+1) 23 | else loop (n-1) (inside) 24 | in 25 | loop total 0 26 | -------------------------------------------------------------------------------- /examples/testproj-1-module/main.ml: -------------------------------------------------------------------------------- 1 | let print_usage_and_exit () = 2 | let () = Printf.printf "Usage: %s something somenumber\n" (Sys.argv.(0)) in 3 | exit 1 4 | 5 | let _ = 6 | if Array.length Sys.argv != 3 7 | then 8 | print_usage_and_exit () 9 | else 10 | try 11 | let s = Sys.argv.(1) in 12 | let i = int_of_string Sys.argv.(2) in 13 | let () = Printf.printf "%s\n" (Lib.greeting s) in 14 | let () = Printf.printf "Factorial of %i is %i\n" i (Lib.fac i) in 15 | let () = Printf.printf "Sum of 1+...+%i is %i\n" i (Lib.sum i) in 16 | let () = Random.self_init () in 17 | let () = Printf.printf "Pi approximation: %f\n" (Lib.pi (i * 1_000_000)) in 18 | () 19 | with (Failure _) -> 20 | print_usage_and_exit () 21 | 22 | -------------------------------------------------------------------------------- /examples/testproj-1-module/ounittest.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let tests = "Code test suite" >::: [ 4 | "fac5" >:: (fun _ -> assert_equal 120 (Lib.fac 5)); 5 | "sum5" >:: (fun _ -> assert_equal 15 (Lib.sum 5)); 6 | "greetFinn" >:: (fun _ -> assert_equal "Hello, Finn" (Lib.greeting "Finn")); 7 | "pi-10mill" >:: (fun _ -> 8 | let pi = Lib.pi 10_000 in 9 | OUnit2.assert_bool "3.14 <= pi" (3.14 <= pi); 10 | OUnit2.assert_bool "pi <= 3.143" (pi <= 3.143)); 11 | ] 12 | 13 | let () = run_test_tt_main tests 14 | -------------------------------------------------------------------------------- /examples/testproj-2-modules/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: test 2 | test: 3 | dune test 4 | 5 | mutamltest: 6 | dune build test/ounittest.exe --instrument-with mutaml 7 | mutaml-runner "dune exec --no-build test/ounittest.exe" 8 | mutaml-report 9 | 10 | clean: 11 | rm -rf *~ src/*~ test/*~ _mutations mutaml-report.json 12 | dune clean 13 | -------------------------------------------------------------------------------- /examples/testproj-2-modules/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps 3 | src/dune 4 | src/lib1.ml 5 | src/lib2.ml 6 | src/main.ml 7 | test/dune 8 | test/ounittest.ml 9 | (package mutaml) 10 | ) 11 | ) 12 | -------------------------------------------------------------------------------- /examples/testproj-2-modules/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.9) 2 | (cram enable) 3 | (formatting disabled) 4 | -------------------------------------------------------------------------------- /examples/testproj-2-modules/dune-workspace: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jmid/mutaml/983230ac24d5433c1d42e18e97ac0ac70149ca62/examples/testproj-2-modules/dune-workspace -------------------------------------------------------------------------------- /examples/testproj-2-modules/src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name lib1) 3 | (modules lib1) 4 | (instrumentation (backend mutaml))) 5 | 6 | (library 7 | (name lib2) 8 | (modules lib2) 9 | (instrumentation (backend mutaml))) 10 | 11 | (executable 12 | (name main) 13 | (modules main) 14 | (libraries lib1 lib2) 15 | (promote (until-clean) (into ..))) 16 | -------------------------------------------------------------------------------- /examples/testproj-2-modules/src/lib1.ml: -------------------------------------------------------------------------------- 1 | let rec fac n = match n with 2 | | 0 -> 1 3 | | _ -> n * fac (n-1) 4 | -------------------------------------------------------------------------------- /examples/testproj-2-modules/src/lib2.ml: -------------------------------------------------------------------------------- 1 | let rec fac n = match n with 2 | | 0 -> 1 3 | | _ -> n * fac (n-1) 4 | 5 | let rec sum n = match n with 6 | | 0 -> 0 7 | | _ -> n + sum (n-1) 8 | -------------------------------------------------------------------------------- /examples/testproj-2-modules/src/main.ml: -------------------------------------------------------------------------------- 1 | let print_usage_and_exit () = 2 | let () = Printf.printf "Usage: %s somenumber\n" (Sys.argv.(0)) in 3 | exit 1 4 | 5 | let _ = 6 | if Array.length Sys.argv != 2 7 | then 8 | print_usage_and_exit () 9 | else 10 | try 11 | let i = int_of_string Sys.argv.(1) in 12 | let () = Printf.printf "Factorial of %i is %i\n" i (Lib1.fac i) in 13 | let () = Printf.printf "Sum of 1+...+%i is %i\n" i (Lib2.sum i) in 14 | () 15 | with (Failure _) -> 16 | print_usage_and_exit () 17 | 18 | -------------------------------------------------------------------------------- /examples/testproj-2-modules/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name ounittest) 3 | (libraries lib1 lib2 ounit2)) 4 | -------------------------------------------------------------------------------- /examples/testproj-2-modules/test/ounittest.ml: -------------------------------------------------------------------------------- 1 | (* These tests use OUnit *) 2 | open OUnit2 3 | 4 | let tests = "Code test suite" >::: [ 5 | "fac5" >:: (fun _ -> assert_equal 120 (Lib1.fac 5)); 6 | "sum5" >:: (fun _ -> assert_equal 15 (Lib2.sum 5)); 7 | (*"fac-equal" >:: (fun _ -> assert_equal (Lib1.fac 5) (Lib2.fac 5));*) 8 | ] 9 | 10 | let () = run_test_tt_main tests 11 | -------------------------------------------------------------------------------- /mutaml.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "0.3" 4 | synopsis: "A mutation tester for OCaml" 5 | description: """ 6 | Mutaml is a mutation testing tool for OCaml. 7 | It uses a ppxlib-based preprocessor to make a series of small 8 | breaking changes to a program's source code and then runs 9 | the program's testsuite for each of them to catch uncaught 10 | misbehaviour. 11 | """ 12 | maintainer: ["Jan Midtgaard "] 13 | authors: ["Jan Midtgaard "] 14 | license: "BSD-2-Clause" 15 | tags: ["test" "mutation testing"] 16 | homepage: "https://github.com/jmid/mutaml" 17 | doc: "https://github.com/jmid/mutaml" 18 | bug-reports: "https://github.com/jmid/mutaml/issues" 19 | depends: [ 20 | "dune" {>= "3.0"} 21 | "ocaml" {>= "4.12.0"} 22 | "ppxlib" {>= "0.28.0"} 23 | "ppx_yojson_conv" {>= "0.14.0"} 24 | "stdlib-random" 25 | "conf-timeout" 26 | "conf-diffutils" 27 | "ocaml-compiler-libs" {>= "v0.12.0"} 28 | "ppx_derivers" {>= "1.2.1"} 29 | "yojson" {>= "2.0.0"} 30 | "ppx_deriving" {with-test} 31 | "ounit2" {with-test} 32 | "odoc" {with-doc} 33 | ] 34 | dev-repo: "git+https://github.com/jmid/mutaml.git" 35 | build: [ 36 | ["dune" "subst"] {dev} 37 | [ 38 | "dune" 39 | "build" 40 | "-p" 41 | name 42 | "-j" 43 | jobs 44 | "@install" 45 | "@runtest" {with-test & arch != "ppc64" & arch != "riscv64"} 46 | "@doc" {with-doc} 47 | ] 48 | ] 49 | x-maintenance-intent: ["(latest)"] 50 | -------------------------------------------------------------------------------- /mutaml.opam.template: -------------------------------------------------------------------------------- 1 | build: [ 2 | ["dune" "subst"] {dev} 3 | [ 4 | "dune" 5 | "build" 6 | "-p" 7 | name 8 | "-j" 9 | jobs 10 | "@install" 11 | "@runtest" {with-test & arch != "ppc64" & arch != "riscv64"} 12 | "@doc" {with-doc} 13 | ] 14 | ] 15 | x-maintenance-intent: ["(latest)"] 16 | -------------------------------------------------------------------------------- /src/common/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name mutaml_common) 3 | (public_name mutaml.common) 4 | (synopsis "Mutaml internal functions (internal)") 5 | (libraries ppxlib) 6 | (preprocess 7 | (pps ppx_yojson_conv))) 8 | -------------------------------------------------------------------------------- /src/common/mutaml_common.ml: -------------------------------------------------------------------------------- 1 | open Ppx_yojson_conv_lib.Yojson_conv.Primitives 2 | 3 | type defaults = 4 | { 5 | ppx_output_prefix : string; 6 | output_file_prefix : string; 7 | mutaml_mut_file : string; 8 | mutaml_report_file : string; 9 | } 10 | 11 | let defaults = 12 | { 13 | (* filenames to communicate through *) 14 | ppx_output_prefix = Filename.concat "_build" "default"; 15 | output_file_prefix = "_mutations"; 16 | mutaml_mut_file = "mutaml-mut-files.txt"; 17 | mutaml_report_file = "mutaml-report.json" 18 | } 19 | 20 | let full_ppx_path ppx_output_prefix fname = 21 | if Filename.is_implicit fname 22 | then Filename.concat ppx_output_prefix fname 23 | else fname 24 | 25 | let full_path fname = 26 | if Filename.is_implicit fname 27 | then Filename.concat defaults.output_file_prefix fname 28 | else fname 29 | 30 | let make_mut_id file_name number = 31 | Printf.sprintf "%s:%i" Filename.(remove_extension file_name) number 32 | 33 | let output_file_name file_name number = 34 | let file_name = Printf.sprintf "%s-mutant%i.output" file_name number in 35 | full_path file_name 36 | (* (String.map (function '/' -> '_' | c -> c) file_name (*Filename.(remove_extension file_name)*)) 37 | number *) 38 | 39 | let fail_and_exit s = 40 | print_endline s; 41 | exit 1 42 | 43 | (* hack to derive yojson for ppxlib types *) 44 | (* https://github.com/ocaml-ppx/ppx_deriving#working-with-existing-types *) 45 | module Loc = 46 | struct 47 | type position = Lexing.position = 48 | { pos_fname : string 49 | ; pos_lnum : int 50 | ; pos_bol : int 51 | ; pos_cnum : int 52 | } 53 | 54 | and location = Location.t = { 55 | loc_start : position; 56 | loc_end : position; 57 | loc_ghost : bool; 58 | } [@@deriving yojson] 59 | end 60 | 61 | 62 | (** A common type to represent mutations *) 63 | type mutant = 64 | { 65 | number : int; 66 | repl : string option; 67 | loc : Loc.location; 68 | } [@@deriving yojson] 69 | 70 | 71 | (** A common type to represent test results *) 72 | type test_result = 73 | { 74 | status : int; 75 | mutant : mutant; 76 | } [@@deriving yojson] 77 | -------------------------------------------------------------------------------- /src/ppx/RS.ml: -------------------------------------------------------------------------------- 1 | (** A minimal RNG interface *) 2 | include Random4.State 3 | 4 | let make_random_seed () = Random4.State.(bits (make_self_init ())) 5 | let init seed = Random4.State.make [|seed|] 6 | let int rs bound = int rs (bound+1) 7 | -------------------------------------------------------------------------------- /src/ppx/RS.mli: -------------------------------------------------------------------------------- 1 | (** A minimal RNG interface *) 2 | type t 3 | val make_random_seed : unit -> int 4 | val int : t -> int -> int 5 | val init : int -> t 6 | val copy : t -> t 7 | -------------------------------------------------------------------------------- /src/ppx/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name mutaml_ppx) 3 | (public_name mutaml) 4 | (wrapped false) 5 | (kind ppx_rewriter) 6 | (instrumentation.backend 7 | (ppx mutaml)) 8 | (libraries mutaml.common ppxlib stdlib-random.v4) 9 | (preprocess 10 | (pps ppxlib.metaquot))) 11 | -------------------------------------------------------------------------------- /src/ppx/entry.ml: -------------------------------------------------------------------------------- 1 | (** Helper module for command line interface *) 2 | module CLI = 3 | struct 4 | (* this part is primarily for the CLI *) 5 | let seed = ref None 6 | let mut_rate = ref None 7 | let gadt = ref None 8 | 9 | let invalid_rate rate = rate < 0 || rate > 100 10 | let set_seed s = (seed := Some s) 11 | let set_rate rate = 12 | if invalid_rate rate 13 | then raise (Arg.Bad (Printf.sprintf "Invalid mutation rate: %i" rate)) 14 | else mut_rate := Some rate 15 | let set_gadt s = (gadt := Some s) 16 | 17 | let arg_spec = [ 18 | ("-seed", Arg.Int set_seed, " Set randomness seed for mutaml's instrumentation"); 19 | ("-mut-rate", Arg.Int set_rate, " Set probability in % of mutating a syntax tree node (default: 50%)"); 20 | ("-gadt", Arg.Bool set_gadt, " Allow only pattern mutations compatible with GADTs (default: true)"); 21 | ] 22 | end 23 | 24 | (** Helper module for environment variables *) 25 | module Env = 26 | struct 27 | (* select a CLI-arg, an environment variable, or a default value -- in that order *) 28 | let select_param cli_arg env_var conversion init_default = 29 | let env_opt = Option.map conversion (Sys.getenv_opt env_var) in 30 | match cli_arg, env_opt with 31 | | Some v, _ -> v 32 | | None , Some s -> s 33 | | None , None -> init_default() 34 | 35 | let parse_seed s = match int_of_string_opt s with 36 | | None -> Mutaml_common.fail_and_exit (Printf.sprintf "Invalid randomness seed: %s" s) 37 | | Some s -> s 38 | 39 | let parse_mut_rate r = match int_of_string_opt r with 40 | | None -> Mutaml_common.fail_and_exit (Printf.sprintf "Invalid mutation rate: %s" r) 41 | | Some r -> 42 | if CLI.invalid_rate r 43 | then Mutaml_common.fail_and_exit (Printf.sprintf "Invalid mutation rate: %i" r) 44 | else r 45 | 46 | let parse_gadt g = match bool_of_string_opt g with 47 | | None -> Mutaml_common.fail_and_exit (Printf.sprintf "Invalid gadt string: %s" g) 48 | | Some b -> b 49 | end 50 | 51 | let () = 52 | List.iter (fun (opt,spec,doc) -> Ppxlib.Driver.add_arg opt spec ~doc) (Arg.align CLI.arg_spec) 53 | 54 | let instrumentation = 55 | let impl_mapper ctx ast = 56 | Mutaml_ppx.Options.seed := 57 | Env.select_param !CLI.seed "MUTAML_SEED" Env.parse_seed RS.make_random_seed; 58 | Mutaml_ppx.Options.mut_rate := 59 | Env.select_param !CLI.mut_rate "MUTAML_MUT_RATE" Env.parse_mut_rate (fun () -> 50); 60 | Mutaml_ppx.Options.gadt := 61 | Env.select_param !CLI.gadt "MUTAML_GADT" Env.parse_gadt (fun () -> true); 62 | let mapper_obj = new Mutaml_ppx.mutate_mapper (RS.init !Mutaml_ppx.Options.seed) in 63 | mapper_obj#transform_impl_file ctx ast in 64 | Ppxlib.Driver.Instrument.V2.make ~position:Before impl_mapper 65 | 66 | let () = Ppxlib.Driver.V2.register_transformation ~instrument:instrumentation "mutaml" 67 | -------------------------------------------------------------------------------- /src/report/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name report) 3 | (public_name mutaml-report) 4 | (package mutaml) 5 | (libraries unix ppxlib mutaml.common) 6 | (promote 7 | (until-clean) 8 | (into ../..))) 9 | -------------------------------------------------------------------------------- /src/report/report.ml: -------------------------------------------------------------------------------- 1 | (* reporter for mutation testing *) 2 | 3 | open Mutaml_common 4 | open Mutaml_common.Loc 5 | 6 | (** Input function *) 7 | 8 | let read_reports report_file = 9 | let open Result in 10 | Printf.printf "Attempting to read from %s...\n" report_file; 11 | let ch = 12 | try open_in report_file 13 | with Sys_error msg -> fail_and_exit (Printf.sprintf "Could not open file %s" msg) 14 | in 15 | let mutants_opt = 16 | try 17 | match Yojson.Safe.from_channel ch with 18 | | `List ys -> Ok (List.map test_result_of_yojson ys) 19 | | _ -> Error "Did not find the expected JSON list" 20 | with Yojson.Json_error _ -> Error "Invalid JSON" 21 | in match mutants_opt with 22 | | Error msg -> 23 | close_in ch; 24 | fail_and_exit (Printf.sprintf "Could not parse JSON in %s: %s" report_file msg) 25 | | Ok mutants -> 26 | mutants 27 | 28 | 29 | (** A type and function to process test result data *) 30 | 31 | type results = 32 | { 33 | count : int; 34 | passed : test_result list; 35 | timeout : test_result list; 36 | failed : test_result list; 37 | } 38 | 39 | let part_results results = 40 | let count = List.length results in 41 | let passed,rest = List.partition (fun res -> res.status = 0) results in 42 | let timeout,failed = List.partition (fun res -> res.status = 124) rest in 43 | {count;passed;timeout;failed} 44 | 45 | 46 | (** Output functions *) 47 | 48 | module CLI = 49 | struct 50 | let usage_msg = 51 | Printf.sprintf "Usage: %s [-no-diff] [file.json]\n%s\n" (Sys.argv.(0)) 52 | "Generates a report summarizing the findings of a mutaml-driver run." 53 | 54 | let print_diff = ref true 55 | 56 | let arg_spec = 57 | Arg.align ["--no-diff", Arg.Clear print_diff, " Don't output diffs to the console"] 58 | 59 | let diff_cmd = match Sys.getenv_opt "MUTAML_DIFF_COMMAND", Sys.getenv_opt "CI" with 60 | | Some cmd, _ -> cmd 61 | | None, Some "true" -> "diff -u" 62 | | None, _ -> "diff --color -u" 63 | end 64 | 65 | let file_contents file_name = 66 | let ch = open_in file_name in 67 | let buf = Buffer.create 1024 in 68 | let rec loop () = 69 | try 70 | let src_line = Stdlib.input_line ch in 71 | Buffer.add_string buf (src_line ^ "\n"); 72 | loop () 73 | with 74 | End_of_file -> 75 | close_in ch; 76 | (*Buffer.add_string buf "\n";*) 77 | Buffer.contents buf in 78 | loop () 79 | 80 | let write_mutated_version output_file ~start ~stop contents repl = 81 | let ch = 82 | try open_out output_file 83 | with Sys_error msg -> fail_and_exit (Printf.sprintf "Could not open file %s" msg) 84 | in 85 | output_string ch (String.sub contents 0 start.pos_cnum); 86 | output_string ch repl; 87 | output_string ch (String.sub contents stop.pos_cnum (String.length contents - stop.pos_cnum)); 88 | close_out ch 89 | 90 | (** prints details for a mutation that passed, i.e., flew under the radar *) 91 | let print_passed print_diff (res:test_result) = 92 | let loc,mut_number = res.mutant.loc,res.mutant.number in 93 | let test_output_file = output_file_name loc.loc_start.pos_fname mut_number in 94 | let file_name = loc.loc_start.pos_fname in 95 | let mut_name = Printf.sprintf "%s-mutant%i" file_name mut_number in 96 | let full_mut_name = full_path mut_name in 97 | let repl = match res.mutant.repl with None -> "" | Some repl -> repl in 98 | let contents = file_contents file_name in 99 | write_mutated_version full_mut_name ~start:loc.loc_start ~stop:loc.loc_end contents repl; 100 | if print_diff 101 | then 102 | begin 103 | Printf.printf "Mutation \"%s\" passed (see \"%s\"):\n\n%!" mut_name test_output_file; 104 | let cmd = 105 | Printf.sprintf "%s --label \"%s\" %s --label \"%s\" %s 1>&2" 106 | CLI.diff_cmd file_name file_name mut_name full_mut_name in 107 | let () = match Sys.command cmd with 108 | | 1 -> () 109 | | 0 -> fail_and_exit "The two source code files did not differ, despite mutation" 110 | | 127 -> fail_and_exit "Could not find the 'diff' command" 111 | | i -> fail_and_exit (Printf.sprintf "'diff' command failed with status code %i" i) 112 | in 113 | Format.printf "\n"; 114 | Format.printf "%s\n\n" (String.make 75 '-'); 115 | end 116 | else 117 | Printf.printf "Mutation \"%s\" passed (see \"%s\")\n%!" mut_name test_output_file 118 | 119 | let part_files results = 120 | let files = List.map (fun r -> r.mutant.loc.loc_start.pos_fname) results 121 | |> List.sort_uniq String.compare in 122 | let per_file_results = 123 | List.fold_left 124 | (fun acc f -> 125 | let from_f = List.filter (fun r -> f = r.mutant.loc.loc_start.pos_fname) results in 126 | (f,from_f)::acc) [] files 127 | in List.rev per_file_results 128 | 129 | let print_report results = 130 | let print_summary_line (label,results) = 131 | let {count;passed;timeout;failed} = part_results results in 132 | let percent c = 100. *. (float_of_int c) /. (float_of_int count) in 133 | let lab c = Printf.sprintf "%3.1f%% %4i" (percent c) c in 134 | let num_passed = List.length passed in 135 | let num_timeout = List.length timeout in 136 | let num_failed = List.length failed in 137 | Printf.printf " %-30s %9i %11s %11s %11s\n" label count (lab num_failed) (lab num_timeout) (lab num_passed); 138 | passed 139 | in 140 | 141 | let part_results = part_files results in 142 | Printf.printf "\nMutaml report summary:\n"; 143 | Printf.printf "----------------------\n\n"; 144 | Printf.printf " %-30s %11s %11s %11s %11s\n" "target" "#mutations" "#failed " "#timeouts" "#passed "; 145 | Format.printf " %s\n" (String.make 85 '-'); 146 | let passed = List.map print_summary_line part_results in 147 | if List.length part_results > 1 148 | then 149 | begin 150 | Format.printf " %s\n" (String.make 85 '-'); 151 | ignore (print_summary_line ("total",results)); 152 | end; 153 | (* *) 154 | Format.printf " %s\n\n" (String.make 85 '='); 155 | List.concat passed 156 | 157 | 158 | (** Executable entry point *) 159 | 160 | let () = 161 | let args = ref [] in 162 | let save_arg arg = (args := arg::!args) in 163 | let () = Arg.parse CLI.arg_spec save_arg CLI.usage_msg in 164 | let report_file = match !args with 165 | | [] -> Mutaml_common.defaults.mutaml_report_file 166 | | [filename] -> filename 167 | | _ -> 168 | fail_and_exit (Arg.usage_string CLI.arg_spec CLI.usage_msg) in 169 | let results = read_reports report_file in 170 | let passed = print_report results in 171 | if passed <> [] 172 | then 173 | (Printf.printf "Mutation programs passing the test suite:\n"; 174 | Printf.printf "-----------------------------------------\n\n"; 175 | List.iter (print_passed !CLI.print_diff) passed) 176 | -------------------------------------------------------------------------------- /src/runner/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name runner) 3 | (public_name mutaml-runner) 4 | (package mutaml) 5 | (libraries unix mutaml.common) 6 | (promote 7 | (until-clean) 8 | (into ../..))) 9 | -------------------------------------------------------------------------------- /src/runner/runner.ml: -------------------------------------------------------------------------------- 1 | (* driver for mutation testing *) 2 | 3 | let timeout_cmd = "timeout" 4 | let timeout = 20 5 | 6 | open Mutaml_common 7 | 8 | (** Input / output functions *) 9 | 10 | (*let meta_outfile = Filename.concat (Sys.getcwd ()) mutaml_mutants_file*) 11 | 12 | (* 13 | Read filenames from _build/default/ ^ mutaml_mut_file 14 | Read mutants from each filename mentioned 15 | Adjust env-variable value to include path+filename+mut: 16 | 17 | src/lib1.ml$0 18 | src/lib2.ml$1 19 | src/somelib/foo.ml:0 <-- path should distinguish these 20 | src/other/foo.ml:0 <-- path should distinguish these 21 | *) 22 | 23 | module CLI = 24 | struct 25 | let usage_string = "Usage: mutaml-runner [options] " 26 | 27 | let print_usage_and_exit () = 28 | Printf.printf "%s\n" usage_string; 29 | exit 1 30 | 31 | let muts_file = ref "" 32 | let build_ctx = ref "" 33 | let arg_spec = 34 | Arg.align 35 | [("--muts", Arg.Set_string muts_file, " Run mutations in the given muts-file"); 36 | ("--build-context", Arg.Set_string build_ctx, " Specify the build context to read from")] 37 | end 38 | 39 | let ensure_output_dir dir_name = 40 | if 0 <> Sys.command ("mkdir -p " ^ dir_name) 41 | then fail_and_exit (Printf.sprintf "Failed to create directory %s" dir_name) 42 | (* Sys.mkdir is a 4.12 addition. Use a crude Sys.command for backwards compat. for now *) 43 | (* 44 | let rec ensure_output_dir dir_name = 45 | try (* base case: directory exists *) 46 | if not (Sys.is_directory dir_name) 47 | then fail_and_exit (Printf.sprintf "Expected directory %s is not a directory" dir_name) 48 | with Sys_error _ -> 49 | (* rec.case: ensure parent directory exists *) 50 | let par_name = Filename.dirname dir_name in 51 | ensure_output_dir par_name; 52 | Sys.mkdir dir_name 0o755 53 | *) 54 | 55 | let test_results = ref [] 56 | 57 | let read_instrumentation_overview ppx_output_prefix file_name = 58 | let rec read_loop ch acc = 59 | try 60 | let file_name = input_line ch in 61 | read_loop ch (file_name::acc) 62 | with End_of_file -> List.rev acc 63 | in 64 | try 65 | let ch = open_in (full_ppx_path ppx_output_prefix file_name) in 66 | let file_names = read_loop ch [] in 67 | let () = close_in ch in 68 | file_names 69 | with Sys_error msg -> 70 | fail_and_exit (Printf.sprintf "Could not read file %s - %s" file_name msg) 71 | 72 | let read_module_mutations_json ppx_output_prefix file_name = 73 | try 74 | let ch = open_in (full_ppx_path ppx_output_prefix file_name) in 75 | let mutants = match Yojson.Safe.from_channel ch with 76 | | `List ys -> List.map mutant_of_yojson ys 77 | | _ -> fail_and_exit ("Could not parse " ^ file_name) 78 | in 79 | mutants 80 | with Sys_error msg -> 81 | fail_and_exit (Printf.sprintf "Could not read file %s - %s" file_name msg) 82 | 83 | let read_all_mutations ppx_output_prefix file_name = 84 | let mut_files = read_instrumentation_overview ppx_output_prefix file_name in 85 | List.iter (fun fname -> Printf.printf "read mut file %s\n%!" fname) mut_files; 86 | List.map (fun f -> (f, read_module_mutations_json ppx_output_prefix f)) mut_files 87 | 88 | let count_mutations (f,ms) = 89 | if ms=[] 90 | then Printf.printf "Warning: No mutations were listed in %s\n" f 91 | else (); 92 | List.length ms 93 | 94 | let validate_muts_file mpair = 95 | if 0 = count_mutations mpair 96 | then fail_and_exit "Exiting as there is no report data to write" 97 | 98 | let validate_mutants file_name muts = 99 | if muts=[] 100 | then fail_and_exit ("No files were listed in " ^ file_name) 101 | else 102 | let counts = List.map count_mutations muts in 103 | if 0 = List.fold_left (+) 0 counts 104 | then 105 | fail_and_exit 106 | (Printf.sprintf "Did not find any mutations across the files listed in %s" file_name) 107 | else () 108 | 109 | let save_test_outcome ret mut = 110 | test_results := { status = ret; mutant = mut }::(!test_results) 111 | 112 | let write_report_file file_name = 113 | Printf.printf "Writing report data to %s\n" file_name; 114 | let ch = open_out file_name in 115 | let ys = !test_results |> List.rev |> List.map yojson_of_test_result in 116 | let () = Yojson.Safe.to_channel ch (`List ys) in 117 | let () = close_out ch in 118 | () 119 | 120 | 121 | (** The actual test runner *) 122 | 123 | let run_single_test test_cmd file_name mut_number = 124 | let mut_id = make_mut_id file_name mut_number in 125 | let output_file = output_file_name file_name mut_number in 126 | ensure_output_dir (Filename.dirname output_file); 127 | let env_test_cmd = 128 | Printf.sprintf "MUTAML_MUTANT=%s %s %i %s > %s 2>&1" mut_id timeout_cmd timeout test_cmd output_file in 129 | let () = Printf.printf "Testing mutant %s ... %!" mut_id in 130 | let ret = Sys.command env_test_cmd in (*tests can both succeed and err*) 131 | let status = match ret with 132 | | 127 -> fail_and_exit (Printf.sprintf "Command not found: failed to run the test command \"%s\"" test_cmd) 133 | | 0 -> "passed" 134 | | 124 -> "timeout" 135 | | _ -> "failed" in 136 | let () = Printf.printf "%s\n%!" status in 137 | ret 138 | 139 | let rec run_module_mutation_tests test_cmd file_name mutants = match mutants with 140 | | [] -> () 141 | | mut::muts -> 142 | let ret = run_single_test test_cmd file_name mut.number in 143 | save_test_outcome ret mut; 144 | run_module_mutation_tests test_cmd file_name muts 145 | 146 | let rec run_all_mutation_tests test_cmd muts = match muts with 147 | | [] -> () 148 | | (file_name, mutations)::muts' -> 149 | run_module_mutation_tests test_cmd file_name mutations; 150 | run_all_mutation_tests test_cmd muts' 151 | 152 | 153 | (** Executable entry point *) 154 | 155 | let () = 156 | if 0 <> Sys.command ("command -v " ^ timeout_cmd ^ " > /dev/null") 157 | then fail_and_exit ("Could not find time-out command: " ^ timeout_cmd) 158 | else 159 | let test_cmd = ref "" in 160 | let set_test_cmd str = if "" = !test_cmd then test_cmd := str else CLI.print_usage_and_exit () in 161 | let () = Arg.parse CLI.arg_spec set_test_cmd CLI.usage_string in 162 | if "" = !test_cmd then CLI.print_usage_and_exit () else 163 | let ppx_output_prefix = match !CLI.build_ctx, Sys.getenv_opt "MUTAML_BUILD_CONTEXT" with 164 | | "", opt -> Option.fold ~some:Fun.id opt ~none:defaults.ppx_output_prefix 165 | | s, _opt -> s in 166 | let mut_file = defaults.mutaml_mut_file in 167 | let mutants = match !CLI.muts_file with 168 | | "" -> 169 | let ms = read_all_mutations ppx_output_prefix mut_file in 170 | validate_mutants mut_file ms; 171 | ms 172 | | muts_file -> 173 | let mpair = (muts_file,read_module_mutations_json ppx_output_prefix muts_file) in 174 | validate_muts_file mpair; 175 | [mpair] 176 | in 177 | ensure_output_dir defaults.output_file_prefix; 178 | run_all_mutation_tests !test_cmd mutants; 179 | write_report_file defaults.mutaml_report_file; 180 | () 181 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (applies_to testproj-1-module testproj-2-modules) 3 | (deps 4 | (package ounit2))) 5 | 6 | ; Add the utitilies to the scope of all the cram tests 7 | 8 | (cram 9 | (applies_to :whole_subtree) 10 | (deps 11 | filter_dune_build.sh 12 | write_dune_files.sh 13 | (package mutaml))) 14 | -------------------------------------------------------------------------------- /test/filter_dune_build.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | # breakdown: 4 | # filter [@@@ocaml.ppx.context whitespace { 0-or-more not-close-brace-chars }] 5 | # and normalize file system paths 6 | dune build $@ 2>&1 | \ 7 | sed -E 'H;1h;$!d;x;s/\[@@@ocaml\.ppx\.context\n\ \ \{[^}]*\}\]//g' | \ 8 | sed -E "/^\/usr\/bin\/ld/d" | \ 9 | sed 's/home[^ ]*bin\//some\/path\/...\/bin\//' | \ 10 | sed 's/Users[^ ]*bin\//some\/path\/...\/bin\//' 11 | -------------------------------------------------------------------------------- /test/instrumentation-tests/arith.t: -------------------------------------------------------------------------------- 1 | Tests mutation of arithmetic expressions 2 | 3 | $ bash ../write_dune_files.sh 4 | 5 | Set seed and (full) mutation rate as environment variables, for repeatability 6 | $ export MUTAML_SEED=896745231 7 | $ export MUTAML_MUT_RATE=100 8 | 9 | 10 | Test + 1: 11 | 12 | $ cat > test.ml <<'EOF' 13 | > let f x = x + 1;; 14 | > assert (f 5 = 6) 15 | > EOF 16 | 17 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 18 | Running mutaml instrumentation on "test.ml" 19 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 20 | Created 1 mutation of test.ml 21 | Writing mutation info to test.muts 22 | 23 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 24 | let __is_mutaml_mutant__ m = 25 | match __MUTAML_MUTANT__ with 26 | | None -> false 27 | | Some mutant -> String.equal m mutant 28 | let f x = if __is_mutaml_mutant__ "test:0" then x else x + 1 29 | ;;assert ((f 5) = 6) 30 | 31 | Check that instrumentation hasn't changed the program's behaviour 32 | $ dune exec --no-build ./test.bc 33 | 34 | And that mutation has changed it as expected 35 | $ MUTAML_MUTANT="test:0" dune exec --no-build ./test.bc 36 | Fatal error: exception Assert_failure("test.ml", 2, 0) 37 | [2] 38 | 39 | 40 | 41 | Test - 1: 42 | 43 | $ cat > test.ml <<'EOF' 44 | > let f x = x - 1;; 45 | > assert (f 5 = 4) 46 | > EOF 47 | 48 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 49 | Running mutaml instrumentation on "test.ml" 50 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 51 | Created 1 mutation of test.ml 52 | Writing mutation info to test.muts 53 | 54 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 55 | let __is_mutaml_mutant__ m = 56 | match __MUTAML_MUTANT__ with 57 | | None -> false 58 | | Some mutant -> String.equal m mutant 59 | let f x = if __is_mutaml_mutant__ "test:0" then x else x - 1 60 | ;;assert ((f 5) = 4) 61 | 62 | $ dune exec --no-build ./test.bc 63 | 64 | $ MUTAML_MUTANT="test:0" dune exec --no-build ./test.bc 65 | Fatal error: exception Assert_failure("test.ml", 2, 0) 66 | [2] 67 | 68 | 69 | 70 | Test 1 +: 71 | z 72 | $ cat > test.ml <<'EOF' 73 | > let f x = 1 + x;; 74 | > assert (f 5 = 6) 75 | > EOF 76 | 77 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 78 | Running mutaml instrumentation on "test.ml" 79 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 80 | Created 1 mutation of test.ml 81 | Writing mutation info to test.muts 82 | 83 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 84 | let __is_mutaml_mutant__ m = 85 | match __MUTAML_MUTANT__ with 86 | | None -> false 87 | | Some mutant -> String.equal m mutant 88 | let f x = if __is_mutaml_mutant__ "test:0" then x else 1 + x 89 | ;;assert ((f 5) = 6) 90 | 91 | $ dune exec --no-build ./test.bc 92 | 93 | $ MUTAML_MUTANT="test:0" dune exec --no-build ./test.bc 94 | Fatal error: exception Assert_failure("test.ml", 2, 0) 95 | [2] 96 | 97 | 98 | 99 | Test addition: 100 | 101 | $ cat > test.ml <<'EOF' 102 | > let f x y = x + y;; 103 | > assert (f 5 6 = 11) 104 | > EOF 105 | 106 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 107 | Running mutaml instrumentation on "test.ml" 108 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 109 | Created 1 mutation of test.ml 110 | Writing mutation info to test.muts 111 | 112 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 113 | let __is_mutaml_mutant__ m = 114 | match __MUTAML_MUTANT__ with 115 | | None -> false 116 | | Some mutant -> String.equal m mutant 117 | let f x y = if __is_mutaml_mutant__ "test:0" then x - y else x + y 118 | ;;assert ((f 5 6) = 11) 119 | 120 | $ dune exec --no-build ./test.bc 121 | 122 | $ MUTAML_MUTANT="test:0" dune exec --no-build ./test.bc 123 | Fatal error: exception Assert_failure("test.ml", 2, 0) 124 | [2] 125 | 126 | -------------------------------------------------------------------------------- 127 | 128 | Test subtraction mutation: 129 | 130 | $ cat > test.ml <<'EOF' 131 | > let f x y = x - y;; 132 | > assert (f 6 5 = 1) 133 | > EOF 134 | 135 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 136 | Running mutaml instrumentation on "test.ml" 137 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 138 | Created 1 mutation of test.ml 139 | Writing mutation info to test.muts 140 | 141 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 142 | let __is_mutaml_mutant__ m = 143 | match __MUTAML_MUTANT__ with 144 | | None -> false 145 | | Some mutant -> String.equal m mutant 146 | let f x y = if __is_mutaml_mutant__ "test:0" then x + y else x - y 147 | ;;assert ((f 6 5) = 1) 148 | 149 | $ dune exec --no-build ./test.bc 150 | 151 | $ MUTAML_MUTANT="test:0" dune exec --no-build ./test.bc 152 | Fatal error: exception Assert_failure("test.ml", 2, 0) 153 | [2] 154 | 155 | 156 | 157 | Test multiplication mutation: 158 | 159 | $ cat > test.ml <<'EOF' 160 | > let f x y = x * y;; 161 | > assert (f 6 5 = 30) 162 | > EOF 163 | 164 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 165 | Running mutaml instrumentation on "test.ml" 166 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 167 | Created 1 mutation of test.ml 168 | Writing mutation info to test.muts 169 | 170 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 171 | let __is_mutaml_mutant__ m = 172 | match __MUTAML_MUTANT__ with 173 | | None -> false 174 | | Some mutant -> String.equal m mutant 175 | let f x y = if __is_mutaml_mutant__ "test:0" then x + y else x * y 176 | ;;assert ((f 6 5) = 30) 177 | 178 | $ dune exec --no-build ./test.bc 179 | 180 | 181 | 182 | Test division mutation: 183 | 184 | $ cat > test.ml <<'EOF' 185 | > let f x y = x / y;; 186 | > assert (f 56 5 = 11) 187 | > EOF 188 | 189 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 190 | Running mutaml instrumentation on "test.ml" 191 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 192 | Created 1 mutation of test.ml 193 | Writing mutation info to test.muts 194 | 195 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 196 | let __is_mutaml_mutant__ m = 197 | match __MUTAML_MUTANT__ with 198 | | None -> false 199 | | Some mutant -> String.equal m mutant 200 | let f x y = if __is_mutaml_mutant__ "test:0" then x mod y else x / y 201 | ;;assert ((f 56 5) = 11) 202 | 203 | $ dune exec --no-build ./test.bc 204 | 205 | $ MUTAML_MUTANT="test:0" dune exec --no-build ./test.bc 206 | Fatal error: exception Assert_failure("test.ml", 2, 0) 207 | [2] 208 | 209 | 210 | 211 | Test modulo mutation: 212 | 213 | $ cat > test.ml <<'EOF' 214 | > let f x y = x mod y;; 215 | > assert (f 56 6 = 2) 216 | > EOF 217 | 218 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 219 | Running mutaml instrumentation on "test.ml" 220 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 221 | Created 1 mutation of test.ml 222 | Writing mutation info to test.muts 223 | 224 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 225 | let __is_mutaml_mutant__ m = 226 | match __MUTAML_MUTANT__ with 227 | | None -> false 228 | | Some mutant -> String.equal m mutant 229 | let f x y = if __is_mutaml_mutant__ "test:0" then x / y else x mod y 230 | ;;assert ((f 56 6) = 2) 231 | 232 | $ dune exec --no-build ./test.bc 233 | 234 | $ MUTAML_MUTANT="test:0" dune exec --no-build ./test.bc 235 | Fatal error: exception Assert_failure("test.ml", 2, 0) 236 | [2] 237 | 238 | 239 | -------------------------------------------------------------------------------- 240 | 241 | Test the evaluation order of arithmetic operands. 242 | 243 | In OCaml the evaluation order of `a` and `b` in `a + b` in unspecified, 244 | but in practice it is currently right-to-left. 245 | 246 | We want to make sure that instrumented programs have the same evaluation 247 | order as non-instrumented programs. 248 | 249 | $ cat > test.ml <<'EOF' 250 | > let f x y = 251 | > (let () = print_endline "left" in x) 252 | > + (let () = print_endline "right" in y);; 253 | > assert (f 5 6 = 11) 254 | > EOF 255 | 256 | Remark on test.ml: we use `let () = print_endline ... in ...` instead of 257 | `print_endline ... ; ...` because the latter form is itself mutated, 258 | and we wanted to only check the arithmetic mutation. This property 259 | may become false in the future if mutaml gets more mutation oprators. 260 | If mutaml supported an attribute to explicitly disable mutations locally, 261 | we should use it instead. 262 | 263 | $ ocaml test.ml 264 | right 265 | left 266 | 267 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 268 | Running mutaml instrumentation on "test.ml" 269 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 270 | Created 1 mutation of test.ml 271 | Writing mutation info to test.muts 272 | 273 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 274 | let __is_mutaml_mutant__ m = 275 | match __MUTAML_MUTANT__ with 276 | | None -> false 277 | | Some mutant -> String.equal m mutant 278 | let f x y = 279 | let __MUTAML_TMP0__ = let () = print_endline "right" in y in 280 | let __MUTAML_TMP1__ = let () = print_endline "left" in x in 281 | if __is_mutaml_mutant__ "test:0" 282 | then __MUTAML_TMP1__ - __MUTAML_TMP0__ 283 | else __MUTAML_TMP1__ + __MUTAML_TMP0__ 284 | ;;assert ((f 5 6) = 11) 285 | 286 | $ dune exec --no-build ./test.bc 287 | right 288 | left 289 | 290 | $ MUTAML_MUTANT="test:0" dune exec --no-build ./test.bc 291 | right 292 | left 293 | Fatal error: exception Assert_failure("test.ml", 4, 0) 294 | [2] 295 | -------------------------------------------------------------------------------- /test/instrumentation-tests/assert.t: -------------------------------------------------------------------------------- 1 | Create dune and dune-project files: 2 | $ bash ../write_dune_files.sh 3 | 4 | Make an .ml-file: 5 | $ cat > test.ml <<'EOF' 6 | > let foo = match Sys.word_size with 7 | > | 32 -> 32 8 | > | _ -> assert false 9 | > EOF 10 | 11 | --------------------------------------------------------------- 12 | Quick interlude: This can be useful to observe the parse tree: 13 | --------------------------------------------------------------- 14 | 15 | ; $ ocamlc -dparsetree test.ml 16 | ; [ 17 | ; structure_item (test.ml[1,0+0]..[3,48+22]) 18 | ; Pstr_value Nonrec 19 | ; [ 20 | ; 21 | ; pattern (test.ml[1,0+4]..[1,0+7]) 22 | ; Ppat_var "foo" (test.ml[1,0+4]..[1,0+7]) 23 | ; expression (test.ml[1,0+10]..[3,48+22]) 24 | ; Pexp_match 25 | ; expression (test.ml[1,0+16]..[1,0+29]) 26 | ; Pexp_ident "Sys.word_size" (test.ml[1,0+16]..[1,0+29]) 27 | ; [ 28 | ; 29 | ; pattern (test.ml[2,35+4]..[2,35+6]) 30 | ; Ppat_constant PConst_int (32,None) 31 | ; expression (test.ml[2,35+10]..[2,35+12]) 32 | ; Pexp_constant PConst_int (32,None) 33 | ; 34 | ; pattern (test.ml[3,48+4]..[3,48+5]) 35 | ; Ppat_any 36 | ; expression (test.ml[3,48+10]..[3,48+22]) 37 | ; Pexp_assert 38 | ; expression (test.ml[3,48+17]..[3,48+22]) 39 | ; Pexp_construct "false" (test.ml[3,48+17]..[3,48+22]) 40 | ; None 41 | ; ] 42 | ; ] 43 | ; ] 44 | 45 | ---------------------------------------------------------------------------------- 46 | Test mutation of the 'assert false': 47 | ---------------------------------------------------------------------------------- 48 | 49 | Set seed and (full) mutation rate as environment variables, for repeatability 50 | $ export MUTAML_SEED=896745231 51 | $ export MUTAML_MUT_RATE=100 52 | 53 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 54 | Running mutaml instrumentation on "test.ml" 55 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 56 | Created 1 mutation of test.ml 57 | Writing mutation info to test.muts 58 | 59 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 60 | let __is_mutaml_mutant__ m = 61 | match __MUTAML_MUTANT__ with 62 | | None -> false 63 | | Some mutant -> String.equal m mutant 64 | let foo = 65 | match Sys.word_size with 66 | | 32 -> if __is_mutaml_mutant__ "test:0" then 33 else 32 67 | | _ -> assert false 68 | 69 | 70 | ---------------------------------------------------------------------------------- 71 | Test mutation of another 'assert' form: 72 | ---------------------------------------------------------------------------------- 73 | 74 | Make an .ml-file: 75 | $ cat > test.ml <<'EOF' 76 | > let foo = match Sys.word_size with 77 | > | 32 -> 32 78 | > | _ -> assert (1>0); 0 79 | > EOF 80 | 81 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 82 | Running mutaml instrumentation on "test.ml" 83 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 84 | Created 3 mutations of test.ml 85 | Writing mutation info to test.muts 86 | 87 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 88 | let __is_mutaml_mutant__ m = 89 | match __MUTAML_MUTANT__ with 90 | | None -> false 91 | | Some mutant -> String.equal m mutant 92 | let foo = 93 | match Sys.word_size with 94 | | 32 -> if __is_mutaml_mutant__ "test:0" then 33 else 32 95 | | _ -> 96 | (if __is_mutaml_mutant__ "test:2" then () else assert (1 > 0); 97 | if __is_mutaml_mutant__ "test:1" then 1 else 0) 98 | 99 | 100 | $ MUTAML_MUTANT="test:0" dune exec --no-build -- ./test.bc 101 | 102 | $ MUTAML_MUTANT="test:1" dune exec --no-build -- ./test.bc 103 | 104 | 105 | ---------------------------------------------------------------------------------- 106 | Test mutation of two asserts: 107 | ---------------------------------------------------------------------------------- 108 | 109 | Make an .ml-file: 110 | $ cat > test.ml <<'EOF' 111 | > let () = 112 | > let tmp = true = not false in 113 | > assert tmp 114 | > let () = 115 | > let tmp = String.length " " = 1 + String.length "" in 116 | > assert tmp 117 | > EOF 118 | 119 | 120 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 121 | Running mutaml instrumentation on "test.ml" 122 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 123 | Created 4 mutations of test.ml 124 | Writing mutation info to test.muts 125 | 126 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 127 | let __is_mutaml_mutant__ m = 128 | match __MUTAML_MUTANT__ with 129 | | None -> false 130 | | Some mutant -> String.equal m mutant 131 | let () = 132 | let tmp = 133 | (if __is_mutaml_mutant__ "test:0" then false else true) = 134 | (not (if __is_mutaml_mutant__ "test:1" then true else false)) in 135 | assert tmp 136 | let () = 137 | let tmp = 138 | (String.length (if __is_mutaml_mutant__ "test:2" then "" else " ")) = 139 | (let __MUTAML_TMP0__ = String.length "" in 140 | if __is_mutaml_mutant__ "test:3" 141 | then __MUTAML_TMP0__ 142 | else 1 + __MUTAML_TMP0__) in 143 | assert tmp 144 | 145 | 146 | Check that running it doesn't fail when run like this 147 | 148 | $ _build/default/test.bc 149 | 150 | or like this: 151 | 152 | $ dune exec --no-build ./test.bc 153 | 154 | 155 | These should all fail however: 156 | 157 | $ MUTAML_MUTANT="test:0" dune exec --no-build ./test.bc 158 | Fatal error: exception Assert_failure("test.ml", 3, 2) 159 | [2] 160 | 161 | $ MUTAML_MUTANT="test:1" dune exec --no-build ./test.bc 162 | Fatal error: exception Assert_failure("test.ml", 3, 2) 163 | [2] 164 | 165 | $ MUTAML_MUTANT="test:2" dune exec --no-build ./test.bc 166 | Fatal error: exception Assert_failure("test.ml", 6, 2) 167 | [2] 168 | 169 | $ MUTAML_MUTANT="test:3" dune exec --no-build ./test.bc 170 | Fatal error: exception Assert_failure("test.ml", 6, 2) 171 | [2] 172 | -------------------------------------------------------------------------------- /test/instrumentation-tests/attributes.t: -------------------------------------------------------------------------------- 1 | Create dune and dune-project files: 2 | # $ bash ../write_dune_files.sh 3 | 4 | Create a dune-project file: 5 | $ echo "(lang dune 2.9)" > dune-project 6 | 7 | Create a dune file enabling warnings 8 | 9 | --------------------------------------------------- 10 | 11 | $ cat > dune <<'EOF' 12 | > ;;(env (_ (flags (:standard -w +3)))) ;;all warnings 13 | > (executable 14 | > (name test) 15 | > ;;(flags (:standard )) 16 | > ;;(flags (:standard -w +3)) 17 | > (ocamlc_flags -dsource) 18 | > (modes byte) 19 | > (instrumentation (backend mutaml)) 20 | > ) 21 | > EOF 22 | 23 | 24 | Create a test.ml file with an attribute 25 | $ cat > test.ml <<'EOF' 26 | > let greet () = print_endline ("Hello," ^ " world!")[@@ppwarning "Stop using hello world!"] 27 | > let () = greet() 28 | > EOF 29 | 30 | 31 | Set seed and (full) mutation rate as environment variables, for repeatability 32 | $ export MUTAML_SEED=896745231 33 | $ export MUTAML_MUT_RATE=100 34 | 35 | 36 | Preprocess, check for attribute and error 37 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 > output.txt 38 | $ head -n 4 output.txt && echo "ERROR MESSAGE" && tail -n 12 output.txt 39 | Running mutaml instrumentation on "test.ml" 40 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 41 | Created 0 mutations of test.ml 42 | Writing mutation info to test.muts 43 | ERROR MESSAGE 44 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 45 | let __is_mutaml_mutant__ m = 46 | match __MUTAML_MUTANT__ with 47 | | None -> false 48 | | Some mutant -> String.equal m mutant 49 | let greet () = print_endline ("Hello," ^ " world!")[@@ppwarning 50 | "Stop using hello world!"] 51 | let () = greet () 52 | File "test.ml", line 1, characters 64-89: 53 | 1 | let greet () = print_endline ("Hello," ^ " world!")[@@ppwarning "Stop using hello world!"] 54 | ^^^^^^^^^^^^^^^^^^^^^^^^^ 55 | Error (warning 22 [preprocessor]): Stop using hello world! 56 | 57 | -------------------------------------------------------------------------------- 58 | 59 | Try same example, but disabling warning 22 via the dune file: 60 | 61 | $ cat > dune <<'EOF' 62 | > (executable 63 | > (name test) 64 | > (ocamlc_flags -dsource -w -22) 65 | > (modes byte) 66 | > (instrumentation (backend mutaml)) 67 | > ) 68 | > EOF 69 | 70 | 71 | Preprocess, check that attribute no longer triggers an error 72 | 73 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 74 | 75 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 76 | let __is_mutaml_mutant__ m = 77 | match __MUTAML_MUTANT__ with 78 | | None -> false 79 | | Some mutant -> String.equal m mutant 80 | let greet () = print_endline ("Hello," ^ " world!")[@@ppwarning 81 | "Stop using hello world!"] 82 | let () = greet () 83 | 84 | -------------------------------------------------------------------------------- 85 | 86 | Another example with '@deprecated': 87 | 88 | $ cat > dune <<'EOF' 89 | > (executable 90 | > (name test) 91 | > (ocamlc_flags -dsource -alert +deprecated) 92 | > (modes byte) 93 | > (instrumentation (backend mutaml)) 94 | > ) 95 | > EOF 96 | 97 | 98 | Create a test.ml file with a module attribute 99 | $ cat > test.ml <<'EOF' 100 | > module T : sig 101 | > val greet : unit -> unit [@@deprecated "Please stop using that example"] 102 | > end = 103 | > struct 104 | > let greet () = print_endline ("Hello," ^ " world!") 105 | > end 106 | > let () = T.greet() 107 | > EOF 108 | 109 | Preprocess, check that attribute triggers deprecation error 110 | 111 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 > output.txt 112 | $ head -n 4 output.txt && echo "ERROR MESSAGE" && tail -n 14 output.txt 113 | Running mutaml instrumentation on "test.ml" 114 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 115 | Created 0 mutations of test.ml 116 | Writing mutation info to test.muts 117 | ERROR MESSAGE 118 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 119 | let __is_mutaml_mutant__ m = 120 | match __MUTAML_MUTANT__ with 121 | | None -> false 122 | | Some mutant -> String.equal m mutant 123 | module T : 124 | sig val greet : unit -> unit[@@deprecated "Please stop using that example"] 125 | end = struct let greet () = print_endline ("Hello," ^ " world!") end 126 | let () = T.greet () 127 | File "test.ml", line 7, characters 9-16: 128 | 7 | let () = T.greet() 129 | ^^^^^^^ 130 | Error (alert deprecated): T.greet 131 | Please stop using that example 132 | 133 | 134 | -------------------------------------------------------------------------------- 135 | 136 | $ cat > dune <<'EOF' 137 | > (executable 138 | > (name test) 139 | > (ocamlc_flags -dsource) 140 | > (modes byte) 141 | > (instrumentation (backend mutaml)) 142 | > ) 143 | > EOF 144 | 145 | 146 | 147 | Attribute on a unit: 148 | -------------------------------------------------------------------------------- 149 | 150 | Create a test.ml file with an attribute 151 | $ cat > test.ml <<'EOF' 152 | > let v = ()[@testattr "unit attr"] 153 | > EOF 154 | 155 | Preprocess, check for attribute and error 156 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 157 | Running mutaml instrumentation on "test.ml" 158 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 159 | Created 0 mutations of test.ml 160 | Writing mutation info to test.muts 161 | 162 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 163 | let __is_mutaml_mutant__ m = 164 | match __MUTAML_MUTANT__ with 165 | | None -> false 166 | | Some mutant -> String.equal m mutant 167 | let v = ((())[@testattr "unit attr"]) 168 | 169 | 170 | Attribute on a bool: 171 | -------------------------------------------------------------------------------- 172 | 173 | Create a test.ml file with an attribute 174 | $ cat > test.ml <<'EOF' 175 | > let t = true[@testattr "true attr"] 176 | > let f = false[@testattr "false attr"] 177 | > EOF 178 | 179 | Preprocess, check for attribute and error 180 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 181 | Running mutaml instrumentation on "test.ml" 182 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 183 | Created 2 mutations of test.ml 184 | Writing mutation info to test.muts 185 | 186 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 187 | let __is_mutaml_mutant__ m = 188 | match __MUTAML_MUTANT__ with 189 | | None -> false 190 | | Some mutant -> String.equal m mutant 191 | let t = 192 | if __is_mutaml_mutant__ "test:0" 193 | then ((false)[@testattr "true attr"]) 194 | else ((true)[@testattr "true attr"]) 195 | let f = 196 | if __is_mutaml_mutant__ "test:1" 197 | then ((true)[@testattr "false attr"]) 198 | else ((false)[@testattr "false attr"]) 199 | 200 | 201 | Attribute on a string: 202 | -------------------------------------------------------------------------------- 203 | 204 | Create a test.ml file with an attribute 205 | $ cat > test.ml <<'EOF' 206 | > let str = " "[@testattr "str attr"] 207 | > EOF 208 | 209 | Preprocess, check for attribute and error 210 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 211 | Running mutaml instrumentation on "test.ml" 212 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 213 | Created 1 mutation of test.ml 214 | Writing mutation info to test.muts 215 | 216 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 217 | let __is_mutaml_mutant__ m = 218 | match __MUTAML_MUTANT__ with 219 | | None -> false 220 | | Some mutant -> String.equal m mutant 221 | let str = 222 | if __is_mutaml_mutant__ "test:0" 223 | then (("")[@testattr "str attr"]) 224 | else ((" ")[@testattr "str attr"]) 225 | 226 | 227 | Attribute on an arithmetic expression: 228 | -------------------------------------------------------------------------------- 229 | 230 | Create a test.ml file with an attribute 231 | $ cat > test.ml <<'EOF' 232 | > let f x = (x + 1)[@testattr "str attr"] 233 | > EOF 234 | 235 | Preprocess, check for attribute and error 236 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 237 | Running mutaml instrumentation on "test.ml" 238 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 239 | Created 1 mutation of test.ml 240 | Writing mutation info to test.muts 241 | 242 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 243 | let __is_mutaml_mutant__ m = 244 | match __MUTAML_MUTANT__ with 245 | | None -> false 246 | | Some mutant -> String.equal m mutant 247 | let f x = 248 | if __is_mutaml_mutant__ "test:0" 249 | then ((x)[@testattr "str attr"]) 250 | else ((x + 1)[@testattr "str attr"]) 251 | 252 | 253 | 254 | 255 | 256 | 3 forms of attributes: 257 | @attr - for expr,typexpr,pattern,module-expr,...,labels,constr 258 | @@attr - for "blocks": module-items, ... 259 | @@@attr - for stand-alone/floating attributes 260 | 261 | Some built-in ones: 262 | [@@ppwarning] 263 | [@@deprecated] 264 | [@@alert] 265 | [@tailcall] 266 | [@@@warning "+9"] disable warning locally 267 | [@@inline] 268 | [@@inlined] 269 | -------------------------------------------------------------------------------- /test/instrumentation-tests/bool.t: -------------------------------------------------------------------------------- 1 | Tests mutating Boolean expressions 2 | 3 | $ bash ../write_dune_files.sh 4 | 5 | Set seed and (full) mutation rate as environment variables, for repeatability 6 | $ export MUTAML_SEED=896745231 7 | $ export MUTAML_MUT_RATE=100 8 | 9 | 10 | Test true: 11 | 12 | $ cat > test.ml <<'EOF' 13 | > let f () = true;; 14 | > assert (f ()) 15 | > EOF 16 | 17 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 18 | Running mutaml instrumentation on "test.ml" 19 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 20 | Created 1 mutation of test.ml 21 | Writing mutation info to test.muts 22 | 23 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 24 | let __is_mutaml_mutant__ m = 25 | match __MUTAML_MUTANT__ with 26 | | None -> false 27 | | Some mutant -> String.equal m mutant 28 | let f () = if __is_mutaml_mutant__ "test:0" then false else true 29 | ;;assert (f ()) 30 | 31 | 32 | Check that instrumentation hasn't changed the program's behaviour 33 | $ dune exec --no-build ./test.bc 34 | 35 | And that mutation has changed it as expected 36 | $ MUTAML_MUTANT="test:0" dune exec --no-build ./test.bc 37 | Fatal error: exception Assert_failure("test.ml", 2, 0) 38 | [2] 39 | 40 | 41 | 42 | Test false: 43 | 44 | $ cat > test.ml <<'EOF' 45 | > let f () = false;; 46 | > assert (not (f ())) 47 | > EOF 48 | 49 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 50 | Running mutaml instrumentation on "test.ml" 51 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 52 | Created 1 mutation of test.ml 53 | Writing mutation info to test.muts 54 | 55 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 56 | let __is_mutaml_mutant__ m = 57 | match __MUTAML_MUTANT__ with 58 | | None -> false 59 | | Some mutant -> String.equal m mutant 60 | let f () = if __is_mutaml_mutant__ "test:0" then true else false 61 | ;;assert (not (f ())) 62 | 63 | $ dune exec --no-build ./test.bc 64 | 65 | $ MUTAML_MUTANT="test:0" dune exec --no-build ./test.bc 66 | Fatal error: exception Assert_failure("test.ml", 2, 0) 67 | [2] 68 | -------------------------------------------------------------------------------- /test/instrumentation-tests/function-omit-case.t: -------------------------------------------------------------------------------- 1 | Create dune and dune-project files: 2 | $ bash ../write_dune_files.sh 3 | 4 | Set seed and (full) mutation rate as environment variables, for repeatability 5 | $ export MUTAML_SEED=896745231 6 | $ export MUTAML_MUT_RATE=100 7 | 8 | Make an .ml-file: 9 | $ cat > test.ml <<'EOF' 10 | > let identify_char = function 11 | > | 'a'..'z' -> "lower-case letter" 12 | > | 'A'..'Z' -> "upper-case letter" 13 | > | '0'..'9' -> "digit" 14 | > | _ -> "other" 15 | > let () = print_endline (identify_char 'e') 16 | > let () = print_endline (identify_char 'U') 17 | > let () = print_endline (identify_char '5') 18 | > let () = print_endline (identify_char '_') 19 | > EOF 20 | 21 | 22 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 23 | Running mutaml instrumentation on "test.ml" 24 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 25 | Created 3 mutations of test.ml 26 | Writing mutation info to test.muts 27 | 28 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 29 | let __is_mutaml_mutant__ m = 30 | match __MUTAML_MUTANT__ with 31 | | None -> false 32 | | Some mutant -> String.equal m mutant 33 | let identify_char = 34 | ((function 35 | | 'a'..'z' when not (__is_mutaml_mutant__ "test:2") -> 36 | "lower-case letter" 37 | | 'A'..'Z' when not (__is_mutaml_mutant__ "test:1") -> 38 | "upper-case letter" 39 | | '0'..'9' when not (__is_mutaml_mutant__ "test:0") -> "digit" 40 | | _ -> "other") 41 | [@ocaml.warning "-8"]) 42 | let () = print_endline (identify_char 'e') 43 | let () = print_endline (identify_char 'U') 44 | let () = print_endline (identify_char '5') 45 | let () = print_endline (identify_char '_') 46 | 47 | 48 | $ _build/default/test.bc 49 | lower-case letter 50 | upper-case letter 51 | digit 52 | other 53 | 54 | $ MUTAML_MUTANT="test:0" _build/default/test.bc 55 | lower-case letter 56 | upper-case letter 57 | other 58 | other 59 | 60 | $ MUTAML_MUTANT="test:1" _build/default/test.bc 61 | lower-case letter 62 | other 63 | digit 64 | other 65 | 66 | $ MUTAML_MUTANT="test:2" _build/default/test.bc 67 | other 68 | upper-case letter 69 | digit 70 | other 71 | 72 | 73 | Start runner and generate report to ensure mutants print correctly: 74 | 75 | $ mutaml-runner _build/default/test.bc 76 | read mut file test.muts 77 | Testing mutant test:0 ... passed 78 | Testing mutant test:1 ... passed 79 | Testing mutant test:2 ... passed 80 | Writing report data to mutaml-report.json 81 | 82 | 83 | $ mutaml-report 84 | Attempting to read from mutaml-report.json... 85 | 86 | Mutaml report summary: 87 | ---------------------- 88 | 89 | target #mutations #failed #timeouts #passed 90 | ------------------------------------------------------------------------------------- 91 | test.ml 3 0.0% 0 0.0% 0 100.0% 3 92 | ===================================================================================== 93 | 94 | Mutation programs passing the test suite: 95 | ----------------------------------------- 96 | 97 | Mutation "test.ml-mutant0" passed (see "_mutations/test.ml-mutant0.output"): 98 | 99 | --- test.ml 100 | +++ test.ml-mutant0 101 | @@ -1,7 +1,6 @@ 102 | let identify_char = function 103 | | 'a'..'z' -> "lower-case letter" 104 | | 'A'..'Z' -> "upper-case letter" 105 | - | '0'..'9' -> "digit" 106 | | _ -> "other" 107 | let () = print_endline (identify_char 'e') 108 | let () = print_endline (identify_char 'U') 109 | 110 | --------------------------------------------------------------------------- 111 | 112 | Mutation "test.ml-mutant1" passed (see "_mutations/test.ml-mutant1.output"): 113 | 114 | --- test.ml 115 | +++ test.ml-mutant1 116 | @@ -1,6 +1,5 @@ 117 | let identify_char = function 118 | | 'a'..'z' -> "lower-case letter" 119 | - | 'A'..'Z' -> "upper-case letter" 120 | | '0'..'9' -> "digit" 121 | | _ -> "other" 122 | let () = print_endline (identify_char 'e') 123 | 124 | --------------------------------------------------------------------------- 125 | 126 | Mutation "test.ml-mutant2" passed (see "_mutations/test.ml-mutant2.output"): 127 | 128 | --- test.ml 129 | +++ test.ml-mutant2 130 | @@ -1,5 +1,4 @@ 131 | let identify_char = function 132 | - | 'a'..'z' -> "lower-case letter" 133 | | 'A'..'Z' -> "upper-case letter" 134 | | '0'..'9' -> "digit" 135 | | _ -> "other" 136 | 137 | --------------------------------------------------------------------------- 138 | 139 | 140 | 141 | Test that same example with a variable will be instrumented with this mutation: 142 | -------------------------------------------------------------------------------- 143 | 144 | $ cat > test.ml <<'EOF' 145 | > let identify_char = function 146 | > | 'a'..'z' -> "lower-case letter" 147 | > | 'A'..'Z' -> "upper-case letter" 148 | > | '0'..'9' -> "digit" 149 | > | c -> "other char: " ^ String.make 1 c 150 | > let () = print_endline (identify_char 'e') 151 | > let () = print_endline (identify_char 'U') 152 | > let () = print_endline (identify_char '5') 153 | > let () = print_endline (identify_char '_') 154 | > EOF 155 | 156 | 157 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 158 | Running mutaml instrumentation on "test.ml" 159 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 160 | Created 4 mutations of test.ml 161 | Writing mutation info to test.muts 162 | 163 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 164 | let __is_mutaml_mutant__ m = 165 | match __MUTAML_MUTANT__ with 166 | | None -> false 167 | | Some mutant -> String.equal m mutant 168 | let identify_char = 169 | ((function 170 | | 'a'..'z' when not (__is_mutaml_mutant__ "test:3") -> 171 | "lower-case letter" 172 | | 'A'..'Z' when not (__is_mutaml_mutant__ "test:2") -> 173 | "upper-case letter" 174 | | '0'..'9' when not (__is_mutaml_mutant__ "test:1") -> "digit" 175 | | c -> 176 | "other char: " ^ 177 | (String.make (if __is_mutaml_mutant__ "test:0" then 0 else 1) c)) 178 | [@ocaml.warning "-8"]) 179 | let () = print_endline (identify_char 'e') 180 | let () = print_endline (identify_char 'U') 181 | let () = print_endline (identify_char '5') 182 | let () = print_endline (identify_char '_') 183 | 184 | 185 | $ _build/default/test.bc 186 | lower-case letter 187 | upper-case letter 188 | digit 189 | other char: _ 190 | 191 | $ MUTAML_MUTANT="test:0" _build/default/test.bc 192 | lower-case letter 193 | upper-case letter 194 | digit 195 | other char: 196 | 197 | $ MUTAML_MUTANT="test:1" _build/default/test.bc 198 | lower-case letter 199 | upper-case letter 200 | other char: 5 201 | other char: _ 202 | 203 | $ MUTAML_MUTANT="test:2" _build/default/test.bc 204 | lower-case letter 205 | other char: U 206 | digit 207 | other char: _ 208 | 209 | $ MUTAML_MUTANT="test:3" _build/default/test.bc 210 | other char: e 211 | upper-case letter 212 | digit 213 | other char: _ 214 | 215 | 216 | 217 | $ mutaml-runner _build/default/test.bc 218 | read mut file test.muts 219 | Testing mutant test:0 ... passed 220 | Testing mutant test:1 ... passed 221 | Testing mutant test:2 ... passed 222 | Testing mutant test:3 ... passed 223 | Writing report data to mutaml-report.json 224 | 225 | 226 | $ mutaml-report 227 | Attempting to read from mutaml-report.json... 228 | 229 | Mutaml report summary: 230 | ---------------------- 231 | 232 | target #mutations #failed #timeouts #passed 233 | ------------------------------------------------------------------------------------- 234 | test.ml 4 0.0% 0 0.0% 0 100.0% 4 235 | ===================================================================================== 236 | 237 | Mutation programs passing the test suite: 238 | ----------------------------------------- 239 | 240 | Mutation "test.ml-mutant0" passed (see "_mutations/test.ml-mutant0.output"): 241 | 242 | --- test.ml 243 | +++ test.ml-mutant0 244 | @@ -2,7 +2,7 @@ 245 | | 'a'..'z' -> "lower-case letter" 246 | | 'A'..'Z' -> "upper-case letter" 247 | | '0'..'9' -> "digit" 248 | - | c -> "other char: " ^ String.make 1 c 249 | + | c -> "other char: " ^ String.make 0 c 250 | let () = print_endline (identify_char 'e') 251 | let () = print_endline (identify_char 'U') 252 | let () = print_endline (identify_char '5') 253 | 254 | --------------------------------------------------------------------------- 255 | 256 | Mutation "test.ml-mutant1" passed (see "_mutations/test.ml-mutant1.output"): 257 | 258 | --- test.ml 259 | +++ test.ml-mutant1 260 | @@ -1,7 +1,6 @@ 261 | let identify_char = function 262 | | 'a'..'z' -> "lower-case letter" 263 | | 'A'..'Z' -> "upper-case letter" 264 | - | '0'..'9' -> "digit" 265 | | c -> "other char: " ^ String.make 1 c 266 | let () = print_endline (identify_char 'e') 267 | let () = print_endline (identify_char 'U') 268 | 269 | --------------------------------------------------------------------------- 270 | 271 | Mutation "test.ml-mutant2" passed (see "_mutations/test.ml-mutant2.output"): 272 | 273 | --- test.ml 274 | +++ test.ml-mutant2 275 | @@ -1,6 +1,5 @@ 276 | let identify_char = function 277 | | 'a'..'z' -> "lower-case letter" 278 | - | 'A'..'Z' -> "upper-case letter" 279 | | '0'..'9' -> "digit" 280 | | c -> "other char: " ^ String.make 1 c 281 | let () = print_endline (identify_char 'e') 282 | 283 | --------------------------------------------------------------------------- 284 | 285 | Mutation "test.ml-mutant3" passed (see "_mutations/test.ml-mutant3.output"): 286 | 287 | --- test.ml 288 | +++ test.ml-mutant3 289 | @@ -1,5 +1,4 @@ 290 | let identify_char = function 291 | - | 'a'..'z' -> "lower-case letter" 292 | | 'A'..'Z' -> "upper-case letter" 293 | | '0'..'9' -> "digit" 294 | | c -> "other char: " ^ String.make 1 c 295 | 296 | --------------------------------------------------------------------------- 297 | 298 | 299 | 300 | Another test w/tuples and wildcards: 301 | -------------------------------------------------------------------------------- 302 | 303 | $ cat > test.ml <<'EOF' 304 | > let prioritize fallback = function 305 | > | Some x, _ -> x 306 | > | _, Some y -> y 307 | > | _, _ -> fallback;; 308 | > prioritize "3rd" (Some "1st",Some "2nd") |> print_endline;; 309 | > prioritize "3rd" (Some "1st",None ) |> print_endline;; 310 | > prioritize "3rd" (None ,Some "2nd") |> print_endline;; 311 | > prioritize "3rd" (None ,None ) |> print_endline 312 | > EOF 313 | 314 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 315 | Running mutaml instrumentation on "test.ml" 316 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 317 | Created 2 mutations of test.ml 318 | Writing mutation info to test.muts 319 | 320 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 321 | let __is_mutaml_mutant__ m = 322 | match __MUTAML_MUTANT__ with 323 | | None -> false 324 | | Some mutant -> String.equal m mutant 325 | let prioritize fallback = 326 | function 327 | | (Some x, _) when not (__is_mutaml_mutant__ "test:1") -> x 328 | | (_, Some y) when not (__is_mutaml_mutant__ "test:0") -> y 329 | | (_, _) -> fallback 330 | ;;(prioritize "3rd" ((Some "1st"), (Some "2nd"))) |> print_endline 331 | ;;(prioritize "3rd" ((Some "1st"), None)) |> print_endline 332 | ;;(prioritize "3rd" (None, (Some "2nd"))) |> print_endline 333 | ;;(prioritize "3rd" (None, None)) |> print_endline 334 | 335 | $ _build/default/test.bc 336 | 1st 337 | 1st 338 | 2nd 339 | 3rd 340 | 341 | $ MUTAML_MUTANT="test:0" _build/default/test.bc 342 | 1st 343 | 1st 344 | 3rd 345 | 3rd 346 | 347 | $ MUTAML_MUTANT="test:1" _build/default/test.bc 348 | 2nd 349 | 3rd 350 | 2nd 351 | 3rd 352 | 353 | 354 | Start runner and generate report to ensure mutants print correctly: 355 | 356 | $ mutaml-runner _build/default/test.bc 357 | read mut file test.muts 358 | Testing mutant test:0 ... passed 359 | Testing mutant test:1 ... passed 360 | Writing report data to mutaml-report.json 361 | 362 | 363 | $ mutaml-report 364 | Attempting to read from mutaml-report.json... 365 | 366 | Mutaml report summary: 367 | ---------------------- 368 | 369 | target #mutations #failed #timeouts #passed 370 | ------------------------------------------------------------------------------------- 371 | test.ml 2 0.0% 0 0.0% 0 100.0% 2 372 | ===================================================================================== 373 | 374 | Mutation programs passing the test suite: 375 | ----------------------------------------- 376 | 377 | Mutation "test.ml-mutant0" passed (see "_mutations/test.ml-mutant0.output"): 378 | 379 | --- test.ml 380 | +++ test.ml-mutant0 381 | @@ -1,6 +1,5 @@ 382 | let prioritize fallback = function 383 | | Some x, _ -> x 384 | - | _, Some y -> y 385 | | _, _ -> fallback;; 386 | prioritize "3rd" (Some "1st",Some "2nd") |> print_endline;; 387 | prioritize "3rd" (Some "1st",None ) |> print_endline;; 388 | 389 | --------------------------------------------------------------------------- 390 | 391 | Mutation "test.ml-mutant1" passed (see "_mutations/test.ml-mutant1.output"): 392 | 393 | --- test.ml 394 | +++ test.ml-mutant1 395 | @@ -1,5 +1,4 @@ 396 | let prioritize fallback = function 397 | - | Some x, _ -> x 398 | | _, Some y -> y 399 | | _, _ -> fallback;; 400 | prioritize "3rd" (Some "1st",Some "2nd") |> print_endline;; 401 | 402 | --------------------------------------------------------------------------- 403 | 404 | 405 | 406 | Same example without wildcards will not be instrumented with this mutation: 407 | -------------------------------------------------------------------------------- 408 | 409 | $ cat > test.ml <<'EOF' 410 | > let prioritize fallback = function 411 | > | Some x, _ -> x 412 | > | _, Some y -> y 413 | > | None, None -> fallback;; 414 | > prioritize "3rd" (Some "1st",Some "2nd") |> print_endline;; 415 | > prioritize "3rd" (Some "1st",None ) |> print_endline;; 416 | > prioritize "3rd" (None ,Some "2nd") |> print_endline;; 417 | > prioritize "3rd" (None ,None ) |> print_endline 418 | > EOF 419 | 420 | 421 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 422 | Running mutaml instrumentation on "test.ml" 423 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 424 | Created 0 mutations of test.ml 425 | Writing mutation info to test.muts 426 | 427 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 428 | let __is_mutaml_mutant__ m = 429 | match __MUTAML_MUTANT__ with 430 | | None -> false 431 | | Some mutant -> String.equal m mutant 432 | let prioritize fallback = 433 | function | (Some x, _) -> x | (_, Some y) -> y | (None, None) -> fallback 434 | ;;(prioritize "3rd" ((Some "1st"), (Some "2nd"))) |> print_endline 435 | ;;(prioritize "3rd" ((Some "1st"), None)) |> print_endline 436 | ;;(prioritize "3rd" (None, (Some "2nd"))) |> print_endline 437 | ;;(prioritize "3rd" (None, None)) |> print_endline 438 | -------------------------------------------------------------------------------- /test/instrumentation-tests/gadts.t: -------------------------------------------------------------------------------- 1 | Create dune and dune-project files: 2 | 3 | $ bash ../write_dune_files.sh 4 | 5 | 6 | An example from Gabriel with GADTs (function-matching). 7 | ---------------------------------------------------------------------------- 8 | 9 | $ cat > test.ml <<'EOF' 10 | > type _ t = 11 | > | Int : int t 12 | > | Bool : bool t 13 | > 14 | > let f (type a) : a t -> a = function 15 | > | Int -> 0 16 | > | Bool -> true 17 | > 18 | > let () = f Int |> Printf.printf "%i\n" 19 | > EOF 20 | 21 | 22 | Check that the example typechecks 23 | $ ocamlc -stop-after typing test.ml 24 | $ export MUTAML_SEED=896745231 25 | $ export MUTAML_MUT_RATE=100 26 | $ export MUTAML_GADT=true 27 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 28 | Running mutaml instrumentation on "test.ml" 29 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 30 | Created 2 mutations of test.ml 31 | Writing mutation info to test.muts 32 | 33 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 34 | let __is_mutaml_mutant__ m = 35 | match __MUTAML_MUTANT__ with 36 | | None -> false 37 | | Some mutant -> String.equal m mutant 38 | type _ t = 39 | | Int: int t 40 | | Bool: bool t 41 | let f (type a) = 42 | (function 43 | | Int -> if __is_mutaml_mutant__ "test:0" then 1 else 0 44 | | Bool -> if __is_mutaml_mutant__ "test:1" then false else true : 45 | a t -> a) 46 | let () = (f Int) |> (Printf.printf "%i\n") 47 | 48 | This shouldn't fail. It should just fail to mutate the patterns. 49 | 50 | 51 | 52 | 53 | Same example from Gabriel with GADTs ('match'-matching) 54 | -------------------------------------------------------------------------------- 55 | 56 | $ cat > test.ml <<'EOF' 57 | > type _ t = 58 | > | Int : int t 59 | > | Bool : bool t 60 | > 61 | > let f (type a) : a t -> a = fun x -> match x with 62 | > | Int -> 0 63 | > | Bool -> true 64 | > 65 | > let () = f Int |> Printf.printf "%i\n" 66 | > EOF 67 | 68 | Check that the example typechecks 69 | $ ocamlc -stop-after typing test.ml 70 | $ export MUTAML_SEED=896745231 71 | $ export MUTAML_GADT=true 72 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 73 | Running mutaml instrumentation on "test.ml" 74 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 75 | Created 2 mutations of test.ml 76 | Writing mutation info to test.muts 77 | 78 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 79 | let __is_mutaml_mutant__ m = 80 | match __MUTAML_MUTANT__ with 81 | | None -> false 82 | | Some mutant -> String.equal m mutant 83 | type _ t = 84 | | Int: int t 85 | | Bool: bool t 86 | let f (type a) = 87 | (fun x -> 88 | match x with 89 | | Int -> if __is_mutaml_mutant__ "test:0" then 1 else 0 90 | | Bool -> if __is_mutaml_mutant__ "test:1" then false else true : 91 | a t -> a) 92 | let () = (f Int) |> (Printf.printf "%i\n") 93 | 94 | This shouldn't fail. It should just fail to mutate the patterns. 95 | 96 | 97 | 98 | 99 | GADT example from the manual 100 | -------------------------------------------------------------------------------- 101 | 102 | $ cat > test.ml <<'EOF' 103 | > type _ t = 104 | > | Int : int t 105 | > | Bool : bool t 106 | > 107 | > let deep : (char t * int) option -> char = function 108 | > | None -> 'c' 109 | > | _ -> . 110 | > EOF 111 | 112 | Check that the example typechecks 113 | $ ocamlc -stop-after typing test.ml 114 | $ export MUTAML_SEED=896745231 115 | $ export MUTAML_GADT=true 116 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 117 | Running mutaml instrumentation on "test.ml" 118 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 119 | Created 0 mutations of test.ml 120 | Writing mutation info to test.muts 121 | 122 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 123 | let __is_mutaml_mutant__ m = 124 | match __MUTAML_MUTANT__ with 125 | | None -> false 126 | | Some mutant -> String.equal m mutant 127 | type _ t = 128 | | Int: int t 129 | | Bool: bool t 130 | let deep : (char t * int) option -> char = function | None -> 'c' | _ -> . 131 | 132 | This shouldn't fail. It should just fail to mutate the patterns. 133 | 134 | 135 | 136 | 137 | 138 | GADT example from manual w.match + an impossible case 139 | -------------------------------------------------------------------------------- 140 | 141 | $ cat > test.ml <<'EOF' 142 | > type _ t = 143 | > | Int : int t 144 | > | Bool : bool t 145 | > 146 | > let deep_match : (char t * int) option -> char = fun x -> match x with 147 | > | None -> 'c' 148 | > | Some (_,0) -> . 149 | > | _ -> . 150 | > EOF 151 | 152 | Check that the example typechecks 153 | $ ocamlc -stop-after typing test.ml 154 | $ export MUTAML_SEED=896745231 155 | $ export MUTAML_GADT=true 156 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 157 | Running mutaml instrumentation on "test.ml" 158 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 159 | Created 0 mutations of test.ml 160 | Writing mutation info to test.muts 161 | 162 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 163 | let __is_mutaml_mutant__ m = 164 | match __MUTAML_MUTANT__ with 165 | | None -> false 166 | | Some mutant -> String.equal m mutant 167 | type _ t = 168 | | Int: int t 169 | | Bool: bool t 170 | let deep_match : (char t * int) option -> char = 171 | fun x -> match x with | None -> 'c' | Some (_, 0) -> . | _ -> . 172 | 173 | This shouldn't fail. It should just fail to mutate the patterns. 174 | 175 | 176 | 177 | 178 | 179 | GADT example from manual w.match 180 | -------------------------------------------------------------------------------- 181 | 182 | $ cat > test.ml <<'EOF' 183 | > type _ t = 184 | > | Int : int t 185 | > | Bool : bool t 186 | > 187 | > let deep_match_refut : (char t * int) option -> char = fun x -> match x with 188 | > | None -> 'c' 189 | > (*| Some (_,0) -> .*) (*impossible, type-wise*) 190 | > | Some (_,_i) -> . (*impossible, type-wise*) 191 | > EOF 192 | 193 | Check that the example typechecks 194 | $ ocamlc -stop-after typing test.ml 195 | $ export MUTAML_SEED=896745231 196 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 197 | Running mutaml instrumentation on "test.ml" 198 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 199 | Created 0 mutations of test.ml 200 | Writing mutation info to test.muts 201 | 202 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 203 | let __is_mutaml_mutant__ m = 204 | match __MUTAML_MUTANT__ with 205 | | None -> false 206 | | Some mutant -> String.equal m mutant 207 | type _ t = 208 | | Int: int t 209 | | Bool: bool t 210 | let deep_match_refut : (char t * int) option -> char = 211 | fun x -> match x with | None -> 'c' | Some (_, _i) -> . 212 | 213 | 214 | This shouldn't fail. It should just fail to mutate the patterns. 215 | 216 | 217 | 218 | 219 | 220 | More GADT examples 221 | -------------------------------------------------------------------------------- 222 | 223 | Pattern matching on GADT constructors in arrays: 224 | 225 | $ cat > test.ml <<'EOF' 226 | > type _ t = 227 | > | Int : int t 228 | > | Bool : bool t 229 | > 230 | > let f (type a) : a t array -> a = function 231 | > | [| Int ; Int |] -> 0 232 | > | [| Bool |] -> true 233 | > | _ -> failwith "ouch" 234 | > EOF 235 | 236 | Check that the example typechecks 237 | $ ocamlc -stop-after typing test.ml 238 | $ export MUTAML_SEED=896745231 239 | $ export MUTAML_GADT=true 240 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 241 | Running mutaml instrumentation on "test.ml" 242 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 243 | Created 4 mutations of test.ml 244 | Writing mutation info to test.muts 245 | 246 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 247 | let __is_mutaml_mutant__ m = 248 | match __MUTAML_MUTANT__ with 249 | | None -> false 250 | | Some mutant -> String.equal m mutant 251 | type _ t = 252 | | Int: int t 253 | | Bool: bool t 254 | let f (type a) = 255 | (function 256 | | [|Int;Int|] when not (__is_mutaml_mutant__ "test:3") -> 257 | if __is_mutaml_mutant__ "test:0" then 1 else 0 258 | | [|Bool|] when not (__is_mutaml_mutant__ "test:2") -> 259 | if __is_mutaml_mutant__ "test:1" then false else true 260 | | _ -> failwith "ouch" : a t array -> a) 261 | 262 | 263 | 264 | Pattern matching on GADT constructors in arrays: 265 | 266 | $ cat > test.ml <<'EOF' 267 | > type _ t = 268 | > | Int : int t 269 | > | Bool : bool t 270 | > | Char : char t 271 | > 272 | > let f (type a) : a t array -> a = function 273 | > | [| Int |] -> 0 274 | > | [| Bool |] -> true 275 | > | [| Char |] -> 'c' 276 | > | _ when true (*2*2=2+2*) -> failwith "empty" 277 | > | _ when false -> failwith "dead" 278 | > EOF 279 | 280 | Check that the example typechecks 281 | $ ocamlc -stop-after typing test.ml 282 | File "test.ml", lines 6-11, characters 34-34: 283 | 6 | ..................................function 284 | 7 | | [| Int |] -> 0 285 | 8 | | [| Bool |] -> true 286 | 9 | | [| Char |] -> 'c' 287 | 10 | | _ when true (*2*2=2+2*) -> failwith "empty" 288 | 11 | | _ when false -> failwith "dead" 289 | Warning 8 [partial-match]: this pattern-matching is not exhaustive. 290 | Here is an example of a case that is not matched: 291 | [| |] 292 | (However, some guarded clause may match this value.) 293 | $ export MUTAML_SEED=896745231 294 | $ export MUTAML_GADT=true 295 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 > output.txt 296 | $ head -n 4 output.txt && echo "ERROR MESSAGE" && tail -n 29 output.txt 297 | Running mutaml instrumentation on "test.ml" 298 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 299 | Created 4 mutations of test.ml 300 | Writing mutation info to test.muts 301 | ERROR MESSAGE 302 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 303 | let __is_mutaml_mutant__ m = 304 | match __MUTAML_MUTANT__ with 305 | | None -> false 306 | | Some mutant -> String.equal m mutant 307 | type _ t = 308 | | Int: int t 309 | | Bool: bool t 310 | | Char: char t 311 | let f (type a) = 312 | (function 313 | | [|Int|] -> if __is_mutaml_mutant__ "test:0" then 1 else 0 314 | | [|Bool|] -> if __is_mutaml_mutant__ "test:1" then false else true 315 | | [|Char|] -> 'c' 316 | | _ when if __is_mutaml_mutant__ "test:2" then false else true -> 317 | failwith "empty" 318 | | _ when if __is_mutaml_mutant__ "test:3" then true else false -> 319 | failwith "dead" : a t array -> a) 320 | File "test.ml", lines 6-11, characters 34-34: 321 | 6 | ..................................function 322 | 7 | | [| Int |] -> 0 323 | 8 | | [| Bool |] -> true 324 | 9 | | [| Char |] -> 'c' 325 | 10 | | _ when true (*2*2=2+2*) -> failwith "empty" 326 | 11 | | _ when false -> failwith "dead" 327 | Error (warning 8 [partial-match]): this pattern-matching is not exhaustive. 328 | Here is an example of a case that is not matched: 329 | [| |] 330 | (However, some guarded clause may match this value.) 331 | 332 | 333 | 334 | 335 | Pattern matching on GADT constructors in arrays w.variables: 336 | 337 | $ cat > test.ml <<'EOF' 338 | > type _ t = 339 | > | Int : int t 340 | > | Bool : bool t 341 | > let f (type a) : a t array -> a = function 342 | > | [| _x ; Int |] -> 2 343 | > | [| Bool ; _x |] -> true 344 | > | _ -> failwith "eww";; 345 | > EOF 346 | 347 | Check that the example typechecks 348 | $ ocamlc -stop-after typing test.ml 349 | $ export MUTAML_SEED=896745231 350 | $ export MUTAML_GADT=true 351 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 352 | Running mutaml instrumentation on "test.ml" 353 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 354 | Created 4 mutations of test.ml 355 | Writing mutation info to test.muts 356 | 357 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 358 | let __is_mutaml_mutant__ m = 359 | match __MUTAML_MUTANT__ with 360 | | None -> false 361 | | Some mutant -> String.equal m mutant 362 | type _ t = 363 | | Int: int t 364 | | Bool: bool t 365 | let f (type a) = 366 | (function 367 | | [|_x;Int|] when not (__is_mutaml_mutant__ "test:3") -> 368 | if __is_mutaml_mutant__ "test:0" then 3 else 2 369 | | [|Bool;_x|] when not (__is_mutaml_mutant__ "test:2") -> 370 | if __is_mutaml_mutant__ "test:1" then false else true 371 | | _ -> failwith "eww" : a t array -> a) 372 | 373 | 374 | 375 | 376 | Pattern matching on GADT constructors in tuples, polymorphically: 377 | 378 | $ cat > test.ml <<'EOF' 379 | > type _ t = 380 | > | Int : int t 381 | > | Bool : bool t 382 | > 383 | > let _f (type a) (type b) : (a t * b t) -> int = function | (Int,_) -> 0 | (_,Bool) -> 1 | _ -> 2 384 | > 385 | > let _f (type a) (type b) : (a t * b t) -> int = function | (Int,Int) -> 0 | (Bool,Bool) -> 1 | _ -> 2 386 | > EOF 387 | 388 | Check that the example typechecks 389 | $ ocamlc -stop-after typing test.ml 390 | $ export MUTAML_SEED=896745231 391 | $ export MUTAML_GADT=true 392 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 393 | Running mutaml instrumentation on "test.ml" 394 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 395 | Created 10 mutations of test.ml 396 | Writing mutation info to test.muts 397 | 398 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 399 | let __is_mutaml_mutant__ m = 400 | match __MUTAML_MUTANT__ with 401 | | None -> false 402 | | Some mutant -> String.equal m mutant 403 | type _ t = 404 | | Int: int t 405 | | Bool: bool t 406 | let _f (type a) (type b) = 407 | (function 408 | | (Int, _) when not (__is_mutaml_mutant__ "test:4") -> 409 | if __is_mutaml_mutant__ "test:0" then 1 else 0 410 | | (_, Bool) when not (__is_mutaml_mutant__ "test:3") -> 411 | if __is_mutaml_mutant__ "test:1" then 0 else 1 412 | | _ -> if __is_mutaml_mutant__ "test:2" then 3 else 2 : (a t * b t) -> int) 413 | let _f (type a) (type b) = 414 | (function 415 | | (Int, Int) when not (__is_mutaml_mutant__ "test:9") -> 416 | if __is_mutaml_mutant__ "test:5" then 1 else 0 417 | | (Bool, Bool) when not (__is_mutaml_mutant__ "test:8") -> 418 | if __is_mutaml_mutant__ "test:6" then 0 else 1 419 | | _ -> if __is_mutaml_mutant__ "test:7" then 3 else 2 : (a t * b t) -> int) 420 | 421 | 422 | 423 | Pattern matching on GADT constructors in tuples, concretely: 424 | 425 | $ cat > test.ml <<'EOF' 426 | > type _ t = 427 | > | Int : int t 428 | > | Bool : bool t 429 | > 430 | > let _f : (int t * bool t) -> int = function | (Int,_) -> 0 | (_,Bool) -> . | _ -> . 431 | > 432 | > let _f : (int t * bool t) -> int = function | (Int,_) -> 0 | (_,Bool) -> . 433 | > 434 | > let _f : (int t * bool t) -> int = function | (Int,_) -> 0 435 | > EOF 436 | 437 | Check that the example typechecks 438 | $ ocamlc -stop-after typing test.ml 439 | $ export MUTAML_SEED=896745231 440 | $ export MUTAML_GADT=true 441 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 442 | Running mutaml instrumentation on "test.ml" 443 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 444 | Created 3 mutations of test.ml 445 | Writing mutation info to test.muts 446 | 447 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 448 | let __is_mutaml_mutant__ m = 449 | match __MUTAML_MUTANT__ with 450 | | None -> false 451 | | Some mutant -> String.equal m mutant 452 | type _ t = 453 | | Int: int t 454 | | Bool: bool t 455 | let _f : (int t * bool t) -> int = 456 | function 457 | | (Int, _) -> if __is_mutaml_mutant__ "test:0" then 1 else 0 458 | | (_, Bool) -> . 459 | | _ -> . 460 | let _f : (int t * bool t) -> int = 461 | function 462 | | (Int, _) -> if __is_mutaml_mutant__ "test:1" then 1 else 0 463 | | (_, Bool) -> . 464 | let _f : (int t * bool t) -> int = 465 | function | (Int, _) -> if __is_mutaml_mutant__ "test:2" then 1 else 0 466 | 467 | 468 | 469 | 470 | Another example from the manual: 471 | 472 | $ cat > test.ml <<'EOF' 473 | > type _ typ = 474 | > | Int : int typ 475 | > | String : string typ 476 | > | Pair : 'a typ * 'b typ -> ('a * 'b) typ 477 | > 478 | > let rec to_string: type t. t typ -> t -> string = 479 | > fun t x -> 480 | > match t with 481 | > | Int -> Int.to_string x 482 | > | String -> Printf.sprintf "%S" x 483 | > | Pair(t1,t2) -> 484 | > let (x1, x2) = x in 485 | > Printf.sprintf "(%s,%s)" (to_string t1 x1) (to_string t2 x2) 486 | > EOF 487 | 488 | Check that the example typechecks 489 | $ ocamlc -stop-after typing test.ml 490 | $ export MUTAML_SEED=896745231 491 | $ export MUTAML_GADT=true 492 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml | sed '/fun x ->/d' | sed 's/fun t ->/fun t x ->/' | sed 's/ m/ m/' | sed 's/ |/ |/' | sed 's/ \{9\}/ /' 493 | Running mutaml instrumentation on "test.ml" 494 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 495 | Created 0 mutations of test.ml 496 | Writing mutation info to test.muts 497 | 498 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 499 | let __is_mutaml_mutant__ m = 500 | match __MUTAML_MUTANT__ with 501 | | None -> false 502 | | Some mutant -> String.equal m mutant 503 | type _ typ = 504 | | Int: int typ 505 | | String: string typ 506 | | Pair: 'a typ * 'b typ -> ('a * 'b) typ 507 | let rec to_string : type t. t typ -> t -> string = 508 | fun t x -> 509 | match t with 510 | | Int -> Int.to_string x 511 | | String -> Printf.sprintf "%S" x 512 | | Pair (t1, t2) -> 513 | let (x1, x2) = x in 514 | Printf.sprintf "(%s,%s)" (to_string t1 x1) (to_string t2 x2) 515 | -------------------------------------------------------------------------------- /test/instrumentation-tests/ifthenelse.t: -------------------------------------------------------------------------------- 1 | Example with a simple if-then-else: 2 | 3 | $ bash ../write_dune_files.sh 4 | 5 | $ cat > test.ml <<'EOF' 6 | > let test x = if x then "true" else "false" 7 | > let () = test true |> print_endline 8 | > let () = test false |> print_endline 9 | > EOF 10 | 11 | $ export MUTAML_SEED=896745231 12 | $ export MUTAML_MUT_RATE=100 13 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 14 | Running mutaml instrumentation on "test.ml" 15 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 16 | Created 3 mutations of test.ml 17 | Writing mutation info to test.muts 18 | 19 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 20 | let __is_mutaml_mutant__ m = 21 | match __MUTAML_MUTANT__ with 22 | | None -> false 23 | | Some mutant -> String.equal m mutant 24 | let test x = 25 | if (if __is_mutaml_mutant__ "test:0" then not x else x) 26 | then "true" 27 | else "false" 28 | let () = 29 | (test (if __is_mutaml_mutant__ "test:1" then false else true)) |> 30 | print_endline 31 | let () = 32 | (test (if __is_mutaml_mutant__ "test:2" then true else false)) |> 33 | print_endline 34 | 35 | 36 | $ _build/default/test.bc 37 | true 38 | false 39 | 40 | $ MUTAML_MUTANT="test:0" _build/default/test.bc 41 | false 42 | true 43 | 44 | 45 | $ mutaml-runner _build/default/test.bc 46 | read mut file test.muts 47 | Testing mutant test:0 ... passed 48 | Testing mutant test:1 ... passed 49 | Testing mutant test:2 ... passed 50 | Writing report data to mutaml-report.json 51 | 52 | 53 | $ mutaml-report 54 | Attempting to read from mutaml-report.json... 55 | 56 | Mutaml report summary: 57 | ---------------------- 58 | 59 | target #mutations #failed #timeouts #passed 60 | ------------------------------------------------------------------------------------- 61 | test.ml 3 0.0% 0 0.0% 0 100.0% 3 62 | ===================================================================================== 63 | 64 | Mutation programs passing the test suite: 65 | ----------------------------------------- 66 | 67 | Mutation "test.ml-mutant0" passed (see "_mutations/test.ml-mutant0.output"): 68 | 69 | --- test.ml 70 | +++ test.ml-mutant0 71 | @@ -1,3 +1,3 @@ 72 | -let test x = if x then "true" else "false" 73 | +let test x = if not x then "true" else "false" 74 | let () = test true |> print_endline 75 | let () = test false |> print_endline 76 | 77 | --------------------------------------------------------------------------- 78 | 79 | Mutation "test.ml-mutant1" passed (see "_mutations/test.ml-mutant1.output"): 80 | 81 | --- test.ml 82 | +++ test.ml-mutant1 83 | @@ -1,3 +1,3 @@ 84 | let test x = if x then "true" else "false" 85 | -let () = test true |> print_endline 86 | +let () = test false |> print_endline 87 | let () = test false |> print_endline 88 | 89 | --------------------------------------------------------------------------- 90 | 91 | Mutation "test.ml-mutant2" passed (see "_mutations/test.ml-mutant2.output"): 92 | 93 | --- test.ml 94 | +++ test.ml-mutant2 95 | @@ -1,3 +1,3 @@ 96 | let test x = if x then "true" else "false" 97 | let () = test true |> print_endline 98 | -let () = test false |> print_endline 99 | +let () = test true |> print_endline 100 | 101 | --------------------------------------------------------------------------- 102 | 103 | 104 | 105 | 106 | 107 | 108 | An example with nested ifs: 109 | --------------------------- 110 | 111 | $ cat > test.ml <<'EOF' 112 | > let test i = 113 | > if i<0 then "negative" else 114 | > if i>0 then "positive" else "zero" 115 | > let () = test ~-5 |> print_endline 116 | > let () = test 0 |> print_endline 117 | > let () = test 5 |> print_endline 118 | > EOF 119 | 120 | $ export MUTAML_SEED=896745231 121 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 122 | Running mutaml instrumentation on "test.ml" 123 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 124 | Created 7 mutations of test.ml 125 | Writing mutation info to test.muts 126 | 127 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 128 | let __is_mutaml_mutant__ m = 129 | match __MUTAML_MUTANT__ with 130 | | None -> false 131 | | Some mutant -> String.equal m mutant 132 | let test i = 133 | if 134 | let __MUTAML_TMP1__ = 135 | i < (if __is_mutaml_mutant__ "test:0" then 1 else 0) in 136 | (if __is_mutaml_mutant__ "test:3" 137 | then not __MUTAML_TMP1__ 138 | else __MUTAML_TMP1__) 139 | then "negative" 140 | else 141 | if 142 | (let __MUTAML_TMP0__ = 143 | i > (if __is_mutaml_mutant__ "test:1" then 1 else 0) in 144 | if __is_mutaml_mutant__ "test:2" 145 | then not __MUTAML_TMP0__ 146 | else __MUTAML_TMP0__) 147 | then "positive" 148 | else "zero" 149 | let () = 150 | (test (- (if __is_mutaml_mutant__ "test:4" then 6 else 5))) |> 151 | print_endline 152 | let () = 153 | (test (if __is_mutaml_mutant__ "test:5" then 1 else 0)) |> print_endline 154 | let () = 155 | (test (if __is_mutaml_mutant__ "test:6" then 6 else 5)) |> print_endline 156 | 157 | 158 | $ _build/default/test.bc 159 | negative 160 | zero 161 | positive 162 | 163 | $ MUTAML_MUTANT="test:3" _build/default/test.bc 164 | zero 165 | negative 166 | negative 167 | 168 | $ MUTAML_MUTANT="test:2" _build/default/test.bc 169 | negative 170 | positive 171 | zero 172 | 173 | 174 | 175 | $ mutaml-runner _build/default/test.bc 176 | read mut file test.muts 177 | Testing mutant test:0 ... passed 178 | Testing mutant test:1 ... passed 179 | Testing mutant test:2 ... passed 180 | Testing mutant test:3 ... passed 181 | Testing mutant test:4 ... passed 182 | Testing mutant test:5 ... passed 183 | Testing mutant test:6 ... passed 184 | Writing report data to mutaml-report.json 185 | 186 | 187 | $ mutaml-report 188 | Attempting to read from mutaml-report.json... 189 | 190 | Mutaml report summary: 191 | ---------------------- 192 | 193 | target #mutations #failed #timeouts #passed 194 | ------------------------------------------------------------------------------------- 195 | test.ml 7 0.0% 0 0.0% 0 100.0% 7 196 | ===================================================================================== 197 | 198 | Mutation programs passing the test suite: 199 | ----------------------------------------- 200 | 201 | Mutation "test.ml-mutant0" passed (see "_mutations/test.ml-mutant0.output"): 202 | 203 | --- test.ml 204 | +++ test.ml-mutant0 205 | @@ -1,5 +1,5 @@ 206 | let test i = 207 | - if i<0 then "negative" else 208 | + if i<1 then "negative" else 209 | if i>0 then "positive" else "zero" 210 | let () = test ~-5 |> print_endline 211 | let () = test 0 |> print_endline 212 | 213 | --------------------------------------------------------------------------- 214 | 215 | Mutation "test.ml-mutant1" passed (see "_mutations/test.ml-mutant1.output"): 216 | 217 | --- test.ml 218 | +++ test.ml-mutant1 219 | @@ -1,6 +1,6 @@ 220 | let test i = 221 | if i<0 then "negative" else 222 | - if i>0 then "positive" else "zero" 223 | + if i>1 then "positive" else "zero" 224 | let () = test ~-5 |> print_endline 225 | let () = test 0 |> print_endline 226 | let () = test 5 |> print_endline 227 | 228 | --------------------------------------------------------------------------- 229 | 230 | Mutation "test.ml-mutant2" passed (see "_mutations/test.ml-mutant2.output"): 231 | 232 | --- test.ml 233 | +++ test.ml-mutant2 234 | @@ -1,6 +1,6 @@ 235 | let test i = 236 | if i<0 then "negative" else 237 | - if i>0 then "positive" else "zero" 238 | + if not (i > 0) then "positive" else "zero" 239 | let () = test ~-5 |> print_endline 240 | let () = test 0 |> print_endline 241 | let () = test 5 |> print_endline 242 | 243 | --------------------------------------------------------------------------- 244 | 245 | Mutation "test.ml-mutant3" passed (see "_mutations/test.ml-mutant3.output"): 246 | 247 | --- test.ml 248 | +++ test.ml-mutant3 249 | @@ -1,5 +1,5 @@ 250 | let test i = 251 | - if i<0 then "negative" else 252 | + if not (i < 0) then "negative" else 253 | if i>0 then "positive" else "zero" 254 | let () = test ~-5 |> print_endline 255 | let () = test 0 |> print_endline 256 | 257 | --------------------------------------------------------------------------- 258 | 259 | Mutation "test.ml-mutant4" passed (see "_mutations/test.ml-mutant4.output"): 260 | 261 | --- test.ml 262 | +++ test.ml-mutant4 263 | @@ -1,6 +1,6 @@ 264 | let test i = 265 | if i<0 then "negative" else 266 | if i>0 then "positive" else "zero" 267 | -let () = test ~-5 |> print_endline 268 | +let () = test ~-6 |> print_endline 269 | let () = test 0 |> print_endline 270 | let () = test 5 |> print_endline 271 | 272 | --------------------------------------------------------------------------- 273 | 274 | Mutation "test.ml-mutant5" passed (see "_mutations/test.ml-mutant5.output"): 275 | 276 | --- test.ml 277 | +++ test.ml-mutant5 278 | @@ -2,5 +2,5 @@ 279 | if i<0 then "negative" else 280 | if i>0 then "positive" else "zero" 281 | let () = test ~-5 |> print_endline 282 | -let () = test 0 |> print_endline 283 | +let () = test 1 |> print_endline 284 | let () = test 5 |> print_endline 285 | 286 | --------------------------------------------------------------------------- 287 | 288 | Mutation "test.ml-mutant6" passed (see "_mutations/test.ml-mutant6.output"): 289 | 290 | --- test.ml 291 | +++ test.ml-mutant6 292 | @@ -3,4 +3,4 @@ 293 | if i>0 then "positive" else "zero" 294 | let () = test ~-5 |> print_endline 295 | let () = test 0 |> print_endline 296 | -let () = test 5 |> print_endline 297 | +let () = test 6 |> print_endline 298 | 299 | --------------------------------------------------------------------------- 300 | 301 | -------------------------------------------------------------------------------- /test/instrumentation-tests/match-omit-case.t: -------------------------------------------------------------------------------- 1 | 2 | Mutation idea: drop a pattern when a later pattern is catch all _: 3 | ------------------------------------------------------------------ 4 | 5 | > match f x with 6 | > | A -> g y 7 | > | B -> h z 8 | > | _ -> i q 9 | 10 | which can be achieved as: 11 | 12 | > match f x with 13 | > | A when __MUTAML_MUTANT__ <> (Some "test:27") -> g y 14 | > | B when __MUTAML_MUTANT__ <> (Some "test:45") -> h z 15 | > | _ -> i q 16 | 17 | Only do so for matches with at least 3 cases? 18 | With only 2 cases present, removing 1 to leave a catch-all case 19 | seems like an unlikely programming error to make: 20 | 21 | > let is_some opt = match opt with 22 | > - | Some _ -> true 23 | > | _ -> false 24 | 25 | The approach also works for or-patterns: 26 | 27 | > match f x with 28 | > | A | B -> g y 29 | > | C -> h z 30 | > | _ -> i q 31 | 32 | and for nested ones: 33 | 34 | > match f x with 35 | > | A (D | E) -> g y 36 | > | C -> h z 37 | > | _ -> i q 38 | 39 | 40 | There is a special case of exception patterns: 41 | 42 | > match f x with 43 | > | exception Not_found -> e q 44 | > | A -> g y 45 | > | B -> h z 46 | > | _ -> i q 47 | 48 | which we filter out and put last: 49 | 50 | > match f x with 51 | > | A when __MUTAML_MUTANT__ <> (Some "test:27") -> g y 52 | > | B when __MUTAML_MUTANT__ <> (Some "test:45") -> h z 53 | > | _ -> i q 54 | > | exception Not_found -> e q 55 | 56 | Overall mutation: 57 | * drop a pattern-match case 58 | * requirement: a _-pattern is present 59 | 60 | -------------------------------------------------------------------------------- 61 | 62 | Create dune and dune-project files: 63 | $ bash ../write_dune_files.sh 64 | 65 | 66 | Make an .ml-file: 67 | $ cat > test.ml <<'EOF' 68 | > let identify_char c = match c with 69 | > | 'a'..'z' -> "lower-case letter" 70 | > | 'A'..'Z' -> "upper-case letter" 71 | > | '0'..'9' -> "digit" 72 | > | _ -> "other" 73 | > let () = print_endline (identify_char 'e') 74 | > let () = print_endline (identify_char 'U') 75 | > let () = print_endline (identify_char '5') 76 | > let () = print_endline (identify_char '_') 77 | > EOF 78 | 79 | 80 | $ export MUTAML_SEED=896745231 81 | $ export MUTAML_MUT_RATE=100 82 | 83 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 84 | Running mutaml instrumentation on "test.ml" 85 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 86 | Created 3 mutations of test.ml 87 | Writing mutation info to test.muts 88 | 89 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 90 | let __is_mutaml_mutant__ m = 91 | match __MUTAML_MUTANT__ with 92 | | None -> false 93 | | Some mutant -> String.equal m mutant 94 | let identify_char c = 95 | ((match c with 96 | | 'a'..'z' when not (__is_mutaml_mutant__ "test:2") -> 97 | "lower-case letter" 98 | | 'A'..'Z' when not (__is_mutaml_mutant__ "test:1") -> 99 | "upper-case letter" 100 | | '0'..'9' when not (__is_mutaml_mutant__ "test:0") -> "digit" 101 | | _ -> "other") 102 | [@ocaml.warning "-8"]) 103 | let () = print_endline (identify_char 'e') 104 | let () = print_endline (identify_char 'U') 105 | let () = print_endline (identify_char '5') 106 | let () = print_endline (identify_char '_') 107 | 108 | 109 | $ _build/default/test.bc 110 | lower-case letter 111 | upper-case letter 112 | digit 113 | other 114 | 115 | $ MUTAML_MUTANT="test:0" _build/default/test.bc 116 | lower-case letter 117 | upper-case letter 118 | other 119 | other 120 | 121 | $ MUTAML_MUTANT="test:1" _build/default/test.bc 122 | lower-case letter 123 | other 124 | digit 125 | other 126 | 127 | $ MUTAML_MUTANT="test:2" _build/default/test.bc 128 | other 129 | upper-case letter 130 | digit 131 | other 132 | 133 | 134 | Start runner and generate report to ensure mutants print correctly: 135 | 136 | $ mutaml-runner _build/default/test.bc 137 | read mut file test.muts 138 | Testing mutant test:0 ... passed 139 | Testing mutant test:1 ... passed 140 | Testing mutant test:2 ... passed 141 | Writing report data to mutaml-report.json 142 | 143 | 144 | $ mutaml-report 145 | Attempting to read from mutaml-report.json... 146 | 147 | Mutaml report summary: 148 | ---------------------- 149 | 150 | target #mutations #failed #timeouts #passed 151 | ------------------------------------------------------------------------------------- 152 | test.ml 3 0.0% 0 0.0% 0 100.0% 3 153 | ===================================================================================== 154 | 155 | Mutation programs passing the test suite: 156 | ----------------------------------------- 157 | 158 | Mutation "test.ml-mutant0" passed (see "_mutations/test.ml-mutant0.output"): 159 | 160 | --- test.ml 161 | +++ test.ml-mutant0 162 | @@ -1,7 +1,6 @@ 163 | let identify_char c = match c with 164 | | 'a'..'z' -> "lower-case letter" 165 | | 'A'..'Z' -> "upper-case letter" 166 | - | '0'..'9' -> "digit" 167 | | _ -> "other" 168 | let () = print_endline (identify_char 'e') 169 | let () = print_endline (identify_char 'U') 170 | 171 | --------------------------------------------------------------------------- 172 | 173 | Mutation "test.ml-mutant1" passed (see "_mutations/test.ml-mutant1.output"): 174 | 175 | --- test.ml 176 | +++ test.ml-mutant1 177 | @@ -1,6 +1,5 @@ 178 | let identify_char c = match c with 179 | | 'a'..'z' -> "lower-case letter" 180 | - | 'A'..'Z' -> "upper-case letter" 181 | | '0'..'9' -> "digit" 182 | | _ -> "other" 183 | let () = print_endline (identify_char 'e') 184 | 185 | --------------------------------------------------------------------------- 186 | 187 | Mutation "test.ml-mutant2" passed (see "_mutations/test.ml-mutant2.output"): 188 | 189 | --- test.ml 190 | +++ test.ml-mutant2 191 | @@ -1,5 +1,4 @@ 192 | let identify_char c = match c with 193 | - | 'a'..'z' -> "lower-case letter" 194 | | 'A'..'Z' -> "upper-case letter" 195 | | '0'..'9' -> "digit" 196 | | _ -> "other" 197 | 198 | --------------------------------------------------------------------------- 199 | 200 | 201 | 202 | Test that same example with a variable will be instrumented with this mutation: 203 | -------------------------------------------------------------------------------- 204 | 205 | $ cat > test.ml <<'EOF' 206 | > let identify_char c = match c with 207 | > | 'a'..'z' -> "lower-case letter" 208 | > | 'A'..'Z' -> "upper-case letter" 209 | > | '0'..'9' -> "digit" 210 | > | c -> "other char: " ^ String.make 1 c 211 | > let () = print_endline (identify_char 'e') 212 | > let () = print_endline (identify_char 'U') 213 | > let () = print_endline (identify_char '5') 214 | > let () = print_endline (identify_char '_') 215 | > EOF 216 | 217 | 218 | $ export MUTAML_SEED=896745231 219 | 220 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 221 | Running mutaml instrumentation on "test.ml" 222 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 223 | Created 4 mutations of test.ml 224 | Writing mutation info to test.muts 225 | 226 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 227 | let __is_mutaml_mutant__ m = 228 | match __MUTAML_MUTANT__ with 229 | | None -> false 230 | | Some mutant -> String.equal m mutant 231 | let identify_char c = 232 | ((match c with 233 | | 'a'..'z' when not (__is_mutaml_mutant__ "test:3") -> 234 | "lower-case letter" 235 | | 'A'..'Z' when not (__is_mutaml_mutant__ "test:2") -> 236 | "upper-case letter" 237 | | '0'..'9' when not (__is_mutaml_mutant__ "test:1") -> "digit" 238 | | c -> 239 | "other char: " ^ 240 | (String.make (if __is_mutaml_mutant__ "test:0" then 0 else 1) c)) 241 | [@ocaml.warning "-8"]) 242 | let () = print_endline (identify_char 'e') 243 | let () = print_endline (identify_char 'U') 244 | let () = print_endline (identify_char '5') 245 | let () = print_endline (identify_char '_') 246 | 247 | 248 | $ _build/default/test.bc 249 | lower-case letter 250 | upper-case letter 251 | digit 252 | other char: _ 253 | 254 | $ MUTAML_MUTANT="test:0" _build/default/test.bc 255 | lower-case letter 256 | upper-case letter 257 | digit 258 | other char: 259 | 260 | $ MUTAML_MUTANT="test:1" _build/default/test.bc 261 | lower-case letter 262 | upper-case letter 263 | other char: 5 264 | other char: _ 265 | 266 | $ MUTAML_MUTANT="test:2" _build/default/test.bc 267 | lower-case letter 268 | other char: U 269 | digit 270 | other char: _ 271 | 272 | $ MUTAML_MUTANT="test:3" _build/default/test.bc 273 | other char: e 274 | upper-case letter 275 | digit 276 | other char: _ 277 | 278 | 279 | 280 | $ mutaml-runner _build/default/test.bc 281 | read mut file test.muts 282 | Testing mutant test:0 ... passed 283 | Testing mutant test:1 ... passed 284 | Testing mutant test:2 ... passed 285 | Testing mutant test:3 ... passed 286 | Writing report data to mutaml-report.json 287 | 288 | 289 | $ mutaml-report 290 | Attempting to read from mutaml-report.json... 291 | 292 | Mutaml report summary: 293 | ---------------------- 294 | 295 | target #mutations #failed #timeouts #passed 296 | ------------------------------------------------------------------------------------- 297 | test.ml 4 0.0% 0 0.0% 0 100.0% 4 298 | ===================================================================================== 299 | 300 | Mutation programs passing the test suite: 301 | ----------------------------------------- 302 | 303 | Mutation "test.ml-mutant0" passed (see "_mutations/test.ml-mutant0.output"): 304 | 305 | --- test.ml 306 | +++ test.ml-mutant0 307 | @@ -2,7 +2,7 @@ 308 | | 'a'..'z' -> "lower-case letter" 309 | | 'A'..'Z' -> "upper-case letter" 310 | | '0'..'9' -> "digit" 311 | - | c -> "other char: " ^ String.make 1 c 312 | + | c -> "other char: " ^ String.make 0 c 313 | let () = print_endline (identify_char 'e') 314 | let () = print_endline (identify_char 'U') 315 | let () = print_endline (identify_char '5') 316 | 317 | --------------------------------------------------------------------------- 318 | 319 | Mutation "test.ml-mutant1" passed (see "_mutations/test.ml-mutant1.output"): 320 | 321 | --- test.ml 322 | +++ test.ml-mutant1 323 | @@ -1,7 +1,6 @@ 324 | let identify_char c = match c with 325 | | 'a'..'z' -> "lower-case letter" 326 | | 'A'..'Z' -> "upper-case letter" 327 | - | '0'..'9' -> "digit" 328 | | c -> "other char: " ^ String.make 1 c 329 | let () = print_endline (identify_char 'e') 330 | let () = print_endline (identify_char 'U') 331 | 332 | --------------------------------------------------------------------------- 333 | 334 | Mutation "test.ml-mutant2" passed (see "_mutations/test.ml-mutant2.output"): 335 | 336 | --- test.ml 337 | +++ test.ml-mutant2 338 | @@ -1,6 +1,5 @@ 339 | let identify_char c = match c with 340 | | 'a'..'z' -> "lower-case letter" 341 | - | 'A'..'Z' -> "upper-case letter" 342 | | '0'..'9' -> "digit" 343 | | c -> "other char: " ^ String.make 1 c 344 | let () = print_endline (identify_char 'e') 345 | 346 | --------------------------------------------------------------------------- 347 | 348 | Mutation "test.ml-mutant3" passed (see "_mutations/test.ml-mutant3.output"): 349 | 350 | --- test.ml 351 | +++ test.ml-mutant3 352 | @@ -1,5 +1,4 @@ 353 | let identify_char c = match c with 354 | - | 'a'..'z' -> "lower-case letter" 355 | | 'A'..'Z' -> "upper-case letter" 356 | | '0'..'9' -> "digit" 357 | | c -> "other char: " ^ String.make 1 c 358 | 359 | --------------------------------------------------------------------------- 360 | 361 | 362 | 363 | Another test w/tuples and wildcards: 364 | -------------------------------------------------------------------------------- 365 | 366 | $ cat > test.ml <<'EOF' 367 | > let prioritize p fallback = match p with 368 | > | Some x, _ -> x 369 | > | _, Some y -> y 370 | > | _, _ -> fallback;; 371 | > prioritize (Some "1st",Some "2nd") "3rd" |> print_endline;; 372 | > prioritize (Some "1st",None ) "3rd" |> print_endline;; 373 | > prioritize (None ,Some "2nd") "3rd" |> print_endline;; 374 | > prioritize (None ,None ) "3rd" |> print_endline 375 | > EOF 376 | 377 | $ export MUTAML_SEED=896745231 378 | 379 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 380 | Running mutaml instrumentation on "test.ml" 381 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 382 | Created 2 mutations of test.ml 383 | Writing mutation info to test.muts 384 | 385 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 386 | let __is_mutaml_mutant__ m = 387 | match __MUTAML_MUTANT__ with 388 | | None -> false 389 | | Some mutant -> String.equal m mutant 390 | let prioritize p fallback = 391 | match p with 392 | | (Some x, _) when not (__is_mutaml_mutant__ "test:1") -> x 393 | | (_, Some y) when not (__is_mutaml_mutant__ "test:0") -> y 394 | | (_, _) -> fallback 395 | ;;(prioritize ((Some "1st"), (Some "2nd")) "3rd") |> print_endline 396 | ;;(prioritize ((Some "1st"), None) "3rd") |> print_endline 397 | ;;(prioritize (None, (Some "2nd")) "3rd") |> print_endline 398 | ;;(prioritize (None, None) "3rd") |> print_endline 399 | 400 | $ _build/default/test.bc 401 | 1st 402 | 1st 403 | 2nd 404 | 3rd 405 | 406 | $ MUTAML_MUTANT="test:0" _build/default/test.bc 407 | 1st 408 | 1st 409 | 3rd 410 | 3rd 411 | 412 | $ MUTAML_MUTANT="test:1" _build/default/test.bc 413 | 2nd 414 | 3rd 415 | 2nd 416 | 3rd 417 | 418 | 419 | Start runner and generate report to ensure mutants print correctly: 420 | 421 | $ mutaml-runner _build/default/test.bc 422 | read mut file test.muts 423 | Testing mutant test:0 ... passed 424 | Testing mutant test:1 ... passed 425 | Writing report data to mutaml-report.json 426 | 427 | 428 | $ mutaml-report 429 | Attempting to read from mutaml-report.json... 430 | 431 | Mutaml report summary: 432 | ---------------------- 433 | 434 | target #mutations #failed #timeouts #passed 435 | ------------------------------------------------------------------------------------- 436 | test.ml 2 0.0% 0 0.0% 0 100.0% 2 437 | ===================================================================================== 438 | 439 | Mutation programs passing the test suite: 440 | ----------------------------------------- 441 | 442 | Mutation "test.ml-mutant0" passed (see "_mutations/test.ml-mutant0.output"): 443 | 444 | --- test.ml 445 | +++ test.ml-mutant0 446 | @@ -1,6 +1,5 @@ 447 | let prioritize p fallback = match p with 448 | | Some x, _ -> x 449 | - | _, Some y -> y 450 | | _, _ -> fallback;; 451 | prioritize (Some "1st",Some "2nd") "3rd" |> print_endline;; 452 | prioritize (Some "1st",None ) "3rd" |> print_endline;; 453 | 454 | --------------------------------------------------------------------------- 455 | 456 | Mutation "test.ml-mutant1" passed (see "_mutations/test.ml-mutant1.output"): 457 | 458 | --- test.ml 459 | +++ test.ml-mutant1 460 | @@ -1,5 +1,4 @@ 461 | let prioritize p fallback = match p with 462 | - | Some x, _ -> x 463 | | _, Some y -> y 464 | | _, _ -> fallback;; 465 | prioritize (Some "1st",Some "2nd") "3rd" |> print_endline;; 466 | 467 | --------------------------------------------------------------------------- 468 | 469 | 470 | 471 | Same example without wildcards will not be instrumented with this mutation: 472 | -------------------------------------------------------------------------------- 473 | 474 | $ cat > test.ml <<'EOF' 475 | > let prioritize p fallback = match p with 476 | > | Some x, _ -> x 477 | > | _, Some y -> y 478 | > | None, None -> fallback;; 479 | > prioritize (Some "1st",Some "2nd") "3rd" |> print_endline;; 480 | > prioritize (Some "1st",None ) "3rd" |> print_endline;; 481 | > prioritize (None ,Some "2nd") "3rd" |> print_endline;; 482 | > prioritize (None ,None ) "3rd" |> print_endline 483 | > EOF 484 | 485 | 486 | $ export MUTAML_SEED=896745231 487 | 488 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 489 | Running mutaml instrumentation on "test.ml" 490 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 491 | Created 0 mutations of test.ml 492 | Writing mutation info to test.muts 493 | 494 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 495 | let __is_mutaml_mutant__ m = 496 | match __MUTAML_MUTANT__ with 497 | | None -> false 498 | | Some mutant -> String.equal m mutant 499 | let prioritize p fallback = 500 | match p with 501 | | (Some x, _) -> x 502 | | (_, Some y) -> y 503 | | (None, None) -> fallback 504 | ;;(prioritize ((Some "1st"), (Some "2nd")) "3rd") |> print_endline 505 | ;;(prioritize ((Some "1st"), None) "3rd") |> print_endline 506 | ;;(prioritize (None, (Some "2nd")) "3rd") |> print_endline 507 | ;;(prioritize (None, None) "3rd") |> print_endline 508 | 509 | 510 | 511 | 512 | A test with exceptions: 513 | ----------------------- 514 | 515 | $ cat > test.ml <<'EOF' 516 | > let my_find h key = match Hashtbl.find h key with 517 | > | Some "" -> "Present with weird special case Some \"\"" 518 | > | Some s -> "Present with Some " ^ s 519 | > | exception Not_found -> "Key not present" 520 | > | _ -> "Present with None" 521 | > let h = Hashtbl.create 42;; 522 | > Hashtbl.add h 0 None;; 523 | > Hashtbl.add h 1 (Some "1");; 524 | > Hashtbl.add h 2 (Some "");; 525 | > my_find h 0 |> print_endline;; 526 | > my_find h 1 |> print_endline;; 527 | > my_find h 2 |> print_endline;; 528 | > my_find h 3 |> print_endline;; 529 | > EOF 530 | 531 | $ export MUTAML_SEED=896745231 532 | 533 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 534 | Running mutaml instrumentation on "test.ml" 535 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 536 | Created 10 mutations of test.ml 537 | Writing mutation info to test.muts 538 | 539 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 540 | let __is_mutaml_mutant__ m = 541 | match __MUTAML_MUTANT__ with 542 | | None -> false 543 | | Some mutant -> String.equal m mutant 544 | let my_find h key = 545 | match Hashtbl.find h key with 546 | | Some "" when not (__is_mutaml_mutant__ "test:1") -> 547 | "Present with weird special case Some \"\"" 548 | | Some s when not (__is_mutaml_mutant__ "test:0") -> 549 | "Present with Some " ^ s 550 | | _ -> "Present with None" 551 | | exception Not_found -> "Key not present" 552 | let h = Hashtbl.create (if __is_mutaml_mutant__ "test:2" then 43 else 42) 553 | ;;Hashtbl.add h (if __is_mutaml_mutant__ "test:3" then 1 else 0) None 554 | ;;Hashtbl.add h (if __is_mutaml_mutant__ "test:4" then 0 else 1) (Some "1") 555 | ;;Hashtbl.add h (if __is_mutaml_mutant__ "test:5" then 3 else 2) (Some "") 556 | ;;(my_find h (if __is_mutaml_mutant__ "test:6" then 1 else 0)) |> 557 | print_endline 558 | ;;(my_find h (if __is_mutaml_mutant__ "test:7" then 0 else 1)) |> 559 | print_endline 560 | ;;(my_find h (if __is_mutaml_mutant__ "test:8" then 3 else 2)) |> 561 | print_endline 562 | ;;(my_find h (if __is_mutaml_mutant__ "test:9" then 4 else 3)) |> 563 | print_endline 564 | 565 | 566 | 567 | Only mutations "test:0" and "test:1 " are relevant to test for here: 568 | 569 | $ dune exec --no-build ./test.bc 570 | Present with None 571 | Present with Some 1 572 | Present with weird special case Some "" 573 | Key not present 574 | 575 | 576 | $ MUTAML_MUTANT="test:0" dune exec --no-build ./test.bc 577 | Present with None 578 | Present with None 579 | Present with weird special case Some "" 580 | Key not present 581 | 582 | 583 | $ MUTAML_MUTANT="test:1" dune exec --no-build ./test.bc 584 | Present with None 585 | Present with Some 1 586 | Present with Some 587 | Key not present 588 | 589 | -------------------------------------------------------------------------------- /test/instrumentation-tests/notes.md: -------------------------------------------------------------------------------- 1 | Notes on Pattern Matching Mutations 2 | =================================== 3 | 4 | Below we motivate the initial pattern matching mutations. 5 | These are enabled with `MUTAML_GADT=false`. 6 | 7 | Unfortunately, many of these pattern mutations are invalid in the 8 | presence of GADTs -- see [gadts.t](gadts.t) for examples. 9 | 10 | 11 | Mutating pattern matching 12 | ------------------------- 13 | 14 | How can the following program be mutated? 15 | 16 | > let () = match !Sys.interactive with 17 | > | true -> print_endline "Running interactively" 18 | > | false -> print_endline "Running in batch mode" 19 | 20 | We could (1) collapse cases using or-patterns: 21 | 22 | > let () = match !Sys.interactive with 23 | > | true 24 | > | false -> print_endline "Running interactively" 25 | 26 | or we could (2) swap right-hand-sides (since no variables are bound in either pattern): 27 | 28 | > let () = match !Sys.interactive with 29 | > | true -> print_endline "Running in batch mode" 30 | > | false -> print_endline "Running interactively" 31 | 32 | 33 | The former could be achieved as follows: 34 | 35 | > let () = 36 | > if __MUTAML_MUTANT__ = (Some "test:27") 37 | > then 38 | > (match !Sys.interactive with 39 | > | true 40 | > | false -> print_endline "Running interactively") 41 | > else 42 | > (match !Sys.interactive with 43 | > | true -> print_endline "Running interactively" 44 | > | false -> print_endline "Running in batch mode") 45 | 46 | This has the disadvantage of duplication, with a worst-case quadratic blow-up. 47 | By moving the test inside the right-hand-side there is less duplication, but still some: 48 | 49 | > let () = 50 | > (match !Sys.interactive with 51 | > | true -> 52 | > (if __MUTAML_MUTANT__ = (Some "test:27") 53 | > then print_endline "Running interactively" 54 | > else print_endline "Running in batch mode") 55 | > | false -> print_endline "Running in batch mode") 56 | 57 | With a guarded pattern match we can avoid most duplication however: 58 | 59 | > let () = 60 | > (match !Sys.interactive with 61 | > | true when __MUTAML_MUTANT__ <> (Some "test:27") 62 | > -> print_endline "Running interactively" 63 | > | true 64 | > | false -> print_endline "Running in batch mode") 65 | 66 | Note: there is still duplication of the matched pattern, 67 | which we deem acceptable for now. 68 | 69 | 70 | Generalizing the type and pattern match 71 | 72 | > type t = A | B | C 73 | > 74 | > match f x with 75 | > | A -> g y 76 | > | B -> h z 77 | > | C -> i q 78 | 79 | we arrive at 80 | 81 | > match f x with 82 | > | A when __MUTAML_MUTANT__ <> (Some "test:27") -> g y 83 | > | A 84 | > | B when __MUTAML_MUTANT__ <> (Some "test:45") -> h z 85 | > | B 86 | > | C -> i q 87 | 88 | This should also work in the presence of data: 89 | 90 | > type t = A | B of bool 91 | > 92 | > match f x with 93 | > | A -> g y 94 | > | B true -> h z 95 | > | B false -> h' z' 96 | 97 | where we expect: 98 | 99 | > match f x with 100 | > | A -> g y 101 | > | B true when __MUTAML_MUTANT__ <> (Some "test:27") -> h z 102 | > | B true 103 | > | B false -> h' z' 104 | 105 | 106 | and with nested matches with either wildcards: 107 | 108 | > type t = A of int*int | B 109 | > 110 | > match f x with 111 | > | A (0,_) -> g0 y0 112 | > | A (_,1) -> g1 y1 113 | > | A p -> gp yp p 114 | > | B -> h z 115 | 116 | or with the same variable bound by the same constructor: 117 | 118 | > type t = A of int*int | B 119 | > 120 | > match f x with 121 | > | A (0,x) -> g0 y0 x 122 | > | A (1,x) -> g1 y1 x 123 | > | A p -> gp yp p 124 | > | B -> h z 125 | 126 | where we expect: 127 | 128 | > match f x with 129 | > | A (0,x) when __MUTAML_MUTANT__ <> (Some "test:27") -> g0 y0 x 130 | > | A (0,x) 131 | > | A (1,x) -> g1 y1 x 132 | > | A p -> gp yp p 133 | > | B -> h z 134 | 135 | The variable requirement ensures syntactically that 'x' has the same 136 | type in both cases, without typing information present. 137 | 138 | A better typing approximation could loosen this requirement 139 | 140 | 141 | 142 | The special case of exception patterns can just be filtered out and moved last (or first): 143 | 144 | > type t = A | B | C 145 | > 146 | > match f x with 147 | > | A -> g y 148 | > | Exception Error -> foo bar 149 | > | B -> h z 150 | > | C -> i q 151 | 152 | yielding 153 | 154 | > match f x with 155 | > | A when __MUTAML_MUTANT__ <> (Some "test:27") -> g y 156 | > | A 157 | > | B when __MUTAML_MUTANT__ <> (Some "test:45") -> h z 158 | > | B 159 | > | C -> i q 160 | > | Exception Error -> foo bar 161 | 162 | 163 | 164 | Overall mutation (1) - merge-into-or-pattern: 165 | * collapse two consecutive pattern-match cases into an or-pattern 166 | * requirement: no variables are bound in either 167 | * -or- same constructor, with same variables bound in both + same positions, recursively 168 | 169 | 170 | Overall mutation (2) - rhs-swapping: 171 | * Swap right-hand sides of two consecutive pattern-match cases 172 | * same requirement 173 | 174 | 175 | 176 | Mutation idea: drop a pattern when a later pattern is catch all `_` 177 | ------------------------------------------------------------------- 178 | 179 | > match f x with 180 | > | A -> g y 181 | > | B -> h z 182 | > | _ -> i q 183 | 184 | which can be achieved as: 185 | 186 | > match f x with 187 | > | A when __MUTAML_MUTANT__ <> (Some "test:27") -> g y 188 | > | B when __MUTAML_MUTANT__ <> (Some "test:45") -> h z 189 | > | _ -> i q 190 | 191 | Only do so for matches with at least 3 cases? 192 | With only 2 cases present, removing 1 to leave a catch-all case 193 | seems like an unlikely programming error to make: 194 | 195 | > let is_some opt = match opt with 196 | > - | Some _ -> true 197 | > | _ -> false 198 | 199 | The approach also works for or-patterns: 200 | 201 | > match f x with 202 | > | A | B -> g y 203 | > | C -> h z 204 | > | _ -> i q 205 | 206 | and for nested ones: 207 | 208 | > match f x with 209 | > | A (D | E) -> g y 210 | > | C -> h z 211 | > | _ -> i q 212 | 213 | 214 | There is a special case of exception patterns: 215 | 216 | > match f x with 217 | > | exception Not_found -> e q 218 | > | A -> g y 219 | > | B -> h z 220 | > | _ -> i q 221 | 222 | which we filter out and put last: 223 | 224 | > match f x with 225 | > | A when __MUTAML_MUTANT__ <> (Some "test:27") -> g y 226 | > | B when __MUTAML_MUTANT__ <> (Some "test:45") -> h z 227 | > | _ -> i q 228 | > | exception Not_found -> e q 229 | 230 | 231 | Overall mutation: 232 | * drop a pattern-match case 233 | * requirement: a _-pattern is present 234 | -------------------------------------------------------------------------------- /test/instrumentation-tests/open_module.t: -------------------------------------------------------------------------------- 1 | Create dune-project file 2 | $ echo "(lang dune 2.9)" > dune-project 3 | 4 | Create a dune file enabling instrumentation 5 | $ cat > dune <<'EOF' 6 | > (executable 7 | > (name b) 8 | > (modules a b) 9 | > (modes byte) 10 | > (ocamlc_flags -dsource) 11 | > (instrumentation (backend mutaml)) 12 | > ) 13 | > EOF 14 | 15 | Make an a.ml-file: 16 | $ cat > a.ml <<'EOF' 17 | > let () = Printf.printf "hello from A!\n" 18 | > let x = 3 19 | > let res = 2 * x = 6 20 | > let () = assert res 21 | > EOF 22 | 23 | Make an b.ml-file: 24 | $ cat > b.ml <<'EOF' 25 | > open A 26 | > let () = Printf.printf "hello from B!\n" 27 | > let res = x = 1 + 2 28 | > let () = assert res 29 | > EOF 30 | 31 | Confirm file creations 32 | $ ls *.ml dune* 33 | a.ml 34 | b.ml 35 | dune 36 | dune-project 37 | 38 | Set seed and (full) mutation rate as environment variables, for repeatability 39 | $ export MUTAML_SEED=896745231 40 | $ export MUTAML_MUT_RATE=100 41 | 42 | ---------------------------------------------------------------------------------- 43 | Test mutation of an 'assert false': 44 | ---------------------------------------------------------------------------------- 45 | 46 | # $ dune build ./b.bc --instrument-with mutaml 47 | $ bash ../filter_dune_build.sh ./b.bc --instrument-with mutaml 48 | Running mutaml instrumentation on "b.ml" 49 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 50 | Created 1 mutation of b.ml 51 | Writing mutation info to b.muts 52 | Running mutaml instrumentation on "a.ml" 53 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 54 | Created 4 mutations of a.ml 55 | Writing mutation info to a.muts 56 | 57 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 58 | let __is_mutaml_mutant__ m = 59 | match __MUTAML_MUTANT__ with 60 | | None -> false 61 | | Some mutant -> String.equal m mutant 62 | let () = Printf.printf "hello from A!\n" 63 | let x = if __is_mutaml_mutant__ "a:0" then 4 else 3 64 | let res = 65 | (let __MUTAML_TMP0__ = if __is_mutaml_mutant__ "a:1" then 3 else 2 in 66 | if __is_mutaml_mutant__ "a:2" 67 | then __MUTAML_TMP0__ + x 68 | else __MUTAML_TMP0__ * x) = (if __is_mutaml_mutant__ "a:3" then 7 else 6) 69 | let () = assert res 70 | 71 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 72 | let __is_mutaml_mutant__ m = 73 | match __MUTAML_MUTANT__ with 74 | | None -> false 75 | | Some mutant -> String.equal m mutant 76 | open A 77 | let () = Printf.printf "hello from B!\n" 78 | let res = x = (if __is_mutaml_mutant__ "b:0" then 2 else 1 + 2) 79 | let () = assert res 80 | 81 | 82 | $ ls _build/default 83 | a.ml 84 | a.muts 85 | a.pp.ml 86 | b.bc 87 | b.ml 88 | b.muts 89 | b.pp.ml 90 | mutaml-mut-files.txt 91 | 92 | $ dune exec --no-build -- ./b.bc 93 | hello from A! 94 | hello from B! 95 | 96 | $ MUTAML_MUTANT="a:0" dune exec --no-build -- ./b.bc 97 | hello from A! 98 | Fatal error: exception Assert_failure("a.ml", 4, 9) 99 | [2] 100 | $ MUTAML_MUTANT="a:1" dune exec --no-build -- ./b.bc 101 | hello from A! 102 | Fatal error: exception Assert_failure("a.ml", 4, 9) 103 | [2] 104 | $ MUTAML_MUTANT="a:2" dune exec --no-build -- ./b.bc 105 | hello from A! 106 | Fatal error: exception Assert_failure("a.ml", 4, 9) 107 | [2] 108 | $ MUTAML_MUTANT="a:3" dune exec --no-build -- ./b.bc 109 | hello from A! 110 | Fatal error: exception Assert_failure("a.ml", 4, 9) 111 | [2] 112 | 113 | $ MUTAML_MUTANT="b:0" dune exec --no-build -- ./b.bc 114 | hello from A! 115 | hello from B! 116 | Fatal error: exception Assert_failure("b.ml", 4, 9) 117 | [2] 118 | $ MUTAML_MUTANT="b:1" dune exec --no-build -- ./b.bc 119 | hello from A! 120 | hello from B! 121 | -------------------------------------------------------------------------------- /test/instrumentation-tests/ppx-args.t: -------------------------------------------------------------------------------- 1 | Create a test.ml file with a few prints: 2 | $ cat > test.ml <<'EOF' 3 | > let () = print_int 10 4 | > let () = print_newline() 5 | > EOF 6 | 7 | Create a dune-project file: 8 | $ echo "(lang dune 2.9)" > dune-project 9 | 10 | 11 | ----------------------------------------------------------------------- 12 | Test default behaviour when passing only seed as environment variable 13 | ----------------------------------------------------------------------- 14 | 15 | $ export MUTAML_SEED=896745231 16 | 17 | $ cat > dune <<'EOF' 18 | > (executable 19 | > (name test) 20 | > (modes byte) 21 | > (instrumentation (backend mutaml)) 22 | > ) 23 | > EOF 24 | 25 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 26 | Running mutaml instrumentation on "test.ml" 27 | Randomness seed: 896745231 Mutation rate: 50 GADTs enabled: true 28 | Created 1 mutation of test.ml 29 | Writing mutation info to test.muts 30 | 31 | 32 | Try passing another seed value: 33 | 34 | $ dune clean 35 | $ export MUTAML_SEED=4231 36 | 37 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 38 | Running mutaml instrumentation on "test.ml" 39 | Randomness seed: 4231 Mutation rate: 50 GADTs enabled: true 40 | Created 1 mutation of test.ml 41 | Writing mutation info to test.muts 42 | 43 | 44 | ----------------------------------------------------------------------- 45 | Test the different options for passing gadt: 46 | * pass as environment variable 47 | * pass as parameter in dune file 48 | * pass as both environment variable and as parameter in dune file 49 | * no passing (above) 50 | ----------------------------------------------------------------------- 51 | 52 | ----------------------------------------------------------------------- 53 | Create a dune file without passing gadt option. Pass it as env.var. 54 | Instrument and check that it was received 55 | ----------------------------------------------------------------------- 56 | 57 | $ dune clean 58 | $ export MUTAML_SEED=896745231 59 | $ export MUTAML_GADT=true 60 | 61 | $ cat > dune <<'EOF' 62 | > (executable 63 | > (name test) 64 | > (modes byte) 65 | > (instrumentation (backend mutaml)) 66 | > ) 67 | > EOF 68 | 69 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 70 | Running mutaml instrumentation on "test.ml" 71 | Randomness seed: 896745231 Mutation rate: 50 GADTs enabled: true 72 | Created 1 mutation of test.ml 73 | Writing mutation info to test.muts 74 | 75 | ----------------------------------------------------------------------- 76 | Create a dune file passing only -gadt true 77 | Instrument and check that it was received 78 | ----------------------------------------------------------------------- 79 | 80 | $ dune clean 81 | $ unset MUTAML_GADT 82 | 83 | $ cat > dune <<'EOF' 84 | > (executable 85 | > (name test) 86 | > (modes byte) 87 | > (instrumentation (backend mutaml -gadt true)) 88 | > ) 89 | > EOF 90 | 91 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 92 | Running mutaml instrumentation on "test.ml" 93 | Randomness seed: 896745231 Mutation rate: 50 GADTs enabled: true 94 | Created 1 mutation of test.ml 95 | Writing mutation info to test.muts 96 | 97 | 98 | ----------------------------------------------------------------------- 99 | Create a dune file passing only -gadt false 100 | Instrument and check that it was received 101 | ----------------------------------------------------------------------- 102 | 103 | $ dune clean 104 | $ unset MUTAML_GADT 105 | 106 | $ cat > dune <<'EOF' 107 | > (executable 108 | > (name test) 109 | > (modes byte) 110 | > (instrumentation (backend mutaml -gadt false)) 111 | > ) 112 | > EOF 113 | 114 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 115 | Running mutaml instrumentation on "test.ml" 116 | Randomness seed: 896745231 Mutation rate: 50 GADTs enabled: false 117 | Created 1 mutation of test.ml 118 | Writing mutation info to test.muts 119 | 120 | 121 | ----------------------------------------------------------------------- 122 | Same dune file passing a seed + environment variable seed 123 | Here the dune file parameter should take precedence 124 | ----------------------------------------------------------------------- 125 | 126 | Force dune to rebuild 127 | $ dune clean 128 | 129 | $ export MUTAML_GADT=false 130 | 131 | $ bash ../filter_dune_build.sh ./test.bc --force --instrument-with mutaml 132 | Running mutaml instrumentation on "test.ml" 133 | Randomness seed: 896745231 Mutation rate: 50 GADTs enabled: false 134 | Created 1 mutation of test.ml 135 | Writing mutation info to test.muts 136 | 137 | $ unset MUTAML_GADT 138 | 139 | 140 | 141 | ----------------------------------------------------------------------- 142 | Test the different options for passing a seed: 143 | * pass as environment variable (above) 144 | * pass as parameter in dune file 145 | * pass as both environment variable and as parameter in dune file 146 | * no passing (omitted because of non-determinism) 147 | ----------------------------------------------------------------------- 148 | 149 | ----------------------------------------------------------------------- 150 | Create a dune file passing only seed 151 | Instrument and check that it was received 152 | ----------------------------------------------------------------------- 153 | 154 | $ unset MUTAML_SEED 155 | 156 | $ cat > dune <<'EOF' 157 | > (executable 158 | > (name test) 159 | > (modes byte) 160 | > (instrumentation (backend mutaml -seed 42)) 161 | > ) 162 | > EOF 163 | 164 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 165 | Running mutaml instrumentation on "test.ml" 166 | Randomness seed: 42 Mutation rate: 50 GADTs enabled: true 167 | Created 0 mutations of test.ml 168 | Writing mutation info to test.muts 169 | 170 | ----------------------------------------------------------------------- 171 | Same dune file passing a seed + environment variable seed 172 | Here the dune file parameter should take precedence 173 | ----------------------------------------------------------------------- 174 | 175 | Force dune to rebuild 176 | $ dune clean 177 | 178 | $ export MUTAML_SEED=896745231 179 | 180 | $ bash ../filter_dune_build.sh ./test.bc --force --instrument-with mutaml 181 | Running mutaml instrumentation on "test.ml" 182 | Randomness seed: 42 Mutation rate: 50 GADTs enabled: true 183 | Created 0 mutations of test.ml 184 | Writing mutation info to test.muts 185 | 186 | 187 | 188 | ----------------------------------------------------------------------- 189 | Test the different options for passing mutation rate: 190 | * pass as environment variable 191 | * pass as parameter in dune file 192 | * pass as both environment variable and as parameter in dune file 193 | * no passing (above) 194 | ----------------------------------------------------------------------- 195 | 196 | ----------------------------------------------------------------------- 197 | Create a dune file without passing mut-rate. Pass it as env.var. 198 | Instrument and check that it was received 199 | ----------------------------------------------------------------------- 200 | 201 | $ export MUTAML_MUT_RATE=100 202 | 203 | $ cat > dune <<'EOF' 204 | > (executable 205 | > (name test) 206 | > (modes byte) 207 | > (instrumentation (backend mutaml)) 208 | > ) 209 | > EOF 210 | 211 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 212 | Running mutaml instrumentation on "test.ml" 213 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 214 | Created 1 mutation of test.ml 215 | Writing mutation info to test.muts 216 | 217 | Try with another value - 33: 218 | 219 | $ dune clean 220 | $ export MUTAML_MUT_RATE=33 221 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 222 | Running mutaml instrumentation on "test.ml" 223 | Randomness seed: 896745231 Mutation rate: 33 GADTs enabled: true 224 | Created 0 mutations of test.ml 225 | Writing mutation info to test.muts 226 | 227 | Try with another value - 0: 228 | 229 | $ dune clean 230 | $ export MUTAML_MUT_RATE=0 231 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 232 | Running mutaml instrumentation on "test.ml" 233 | Randomness seed: 896745231 Mutation rate: 0 GADTs enabled: true 234 | Created 0 mutations of test.ml 235 | Writing mutation info to test.muts 236 | 237 | 238 | ----------------------------------------------------------------------- 239 | Create a dune file passing only mut-rate 240 | Instrument and check that it was received 241 | ----------------------------------------------------------------------- 242 | 243 | $ unset MUTAML_MUT_RATE 244 | 245 | $ cat > dune <<'EOF' 246 | > (executable 247 | > (name test) 248 | > (modes byte) 249 | > (instrumentation (backend mutaml -mut-rate 75)) 250 | > ) 251 | > EOF 252 | 253 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 254 | Running mutaml instrumentation on "test.ml" 255 | Randomness seed: 896745231 Mutation rate: 75 GADTs enabled: true 256 | Created 1 mutation of test.ml 257 | Writing mutation info to test.muts 258 | 259 | ----------------------------------------------------------------------- 260 | Same dune file passing mut-rate + environment variable mut-rate 261 | Here the dune file parameter should take precedence 262 | ----------------------------------------------------------------------- 263 | 264 | $ dune clean 265 | 266 | $ export MUTAML_MUT_RATE=100 267 | 268 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 269 | Running mutaml instrumentation on "test.ml" 270 | Randomness seed: 896745231 Mutation rate: 75 GADTs enabled: true 271 | Created 1 mutation of test.ml 272 | Writing mutation info to test.muts 273 | 274 | 275 | ----------------------------------------------------------------------- 276 | Create a dune file passing both seed and mut-rate 277 | Instrument and check that they were received 278 | ----------------------------------------------------------------------- 279 | 280 | $ cat > dune <<'EOF' 281 | > (executable 282 | > (name test) 283 | > (modes byte) 284 | > (instrumentation (backend mutaml -seed 42 -mut-rate 75)) 285 | > ) 286 | > EOF 287 | 288 | 289 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 290 | Running mutaml instrumentation on "test.ml" 291 | Randomness seed: 42 Mutation rate: 75 GADTs enabled: true 292 | Created 0 mutations of test.ml 293 | Writing mutation info to test.muts 294 | 295 | 296 | 297 | 298 | 299 | ----------------------------------------------------------------------- 300 | Test no mutation - with mutation rate 0 301 | ----------------------------------------------------------------------- 302 | 303 | Create a test.ml file with a few prints: 304 | $ cat > test.ml <<'EOF' 305 | > let l = [0;1;2;3;4;5;6;7;8;9] 306 | > let o = if false || true then " " else "" 307 | > let () = print_int 10 308 | > let () = print_newline() 309 | > EOF 310 | 311 | ----------------------------------------------------------------------- 312 | Create a dune file passing mut-rate 0 313 | Instrument and check that it was received - with no mutation 314 | ----------------------------------------------------------------------- 315 | 316 | $ unset MUTAML_MUT_RATE 317 | 318 | $ cat > dune <<'EOF' 319 | > (executable 320 | > (name test) 321 | > (modes byte) 322 | > (instrumentation (backend mutaml -mut-rate 0)) 323 | > ) 324 | > EOF 325 | 326 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 327 | Running mutaml instrumentation on "test.ml" 328 | Randomness seed: 896745231 Mutation rate: 0 GADTs enabled: true 329 | Created 0 mutations of test.ml 330 | Writing mutation info to test.muts 331 | 332 | 333 | Repeat with a few other seeds: 334 | 335 | $ dune clean 336 | $ export MUTAML_SEED=325 337 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 338 | Running mutaml instrumentation on "test.ml" 339 | Randomness seed: 325 Mutation rate: 0 GADTs enabled: true 340 | Created 0 mutations of test.ml 341 | Writing mutation info to test.muts 342 | 343 | 344 | $ dune clean 345 | $ export MUTAML_SEED=87324 346 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 347 | Running mutaml instrumentation on "test.ml" 348 | Randomness seed: 87324 Mutation rate: 0 GADTs enabled: true 349 | Created 0 mutations of test.ml 350 | Writing mutation info to test.muts 351 | 352 | 353 | $ dune clean 354 | $ export MUTAML_SEED=9825453 355 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 356 | Running mutaml instrumentation on "test.ml" 357 | Randomness seed: 9825453 Mutation rate: 0 GADTs enabled: true 358 | Created 0 mutations of test.ml 359 | Writing mutation info to test.muts 360 | 361 | ----------------------------------------------------------------------- 362 | Test behaviour with another building context 363 | ----------------------------------------------------------------------- 364 | 365 | Create a dune-workspace file with another build context: 366 | $ cat > dune-workspace <<'EOF' 367 | > (lang dune 2.9) 368 | > (context default) 369 | > (context (default (name mutation) (instrument_with mutaml))) 370 | > EOF 371 | 372 | And a dune file: 373 | $ cat > dune <<'EOF' 374 | > (executable 375 | > (name test) 376 | > (modes byte) 377 | > (instrumentation (backend mutaml)) 378 | > ) 379 | > EOF 380 | 381 | 382 | 383 | $ dune clean 384 | $ export MUTAML_SEED=896745231 385 | $ bash ../filter_dune_build.sh _build/mutation/test.bc --force 386 | Running mutaml instrumentation on "test.ml" 387 | Randomness seed: 896745231 Mutation rate: 50 GADTs enabled: true 388 | Created 7 mutations of test.ml 389 | Writing mutation info to test.muts 390 | 391 | 392 | $ ls _build/mutation 393 | mutaml-mut-files.txt 394 | test.bc 395 | test.ml 396 | test.muts 397 | test.pp.ml 398 | 399 | $ export MUTAML_BUILD_CONTEXT="_build/mutation" 400 | $ mutaml-runner _build/mutation/test.bc 401 | read mut file test.muts 402 | Testing mutant test:0 ... passed 403 | Testing mutant test:1 ... passed 404 | Testing mutant test:2 ... passed 405 | Testing mutant test:3 ... passed 406 | Testing mutant test:4 ... passed 407 | Testing mutant test:5 ... passed 408 | Testing mutant test:6 ... passed 409 | Writing report data to mutaml-report.json 410 | -------------------------------------------------------------------------------- /test/instrumentation-tests/records.t: -------------------------------------------------------------------------------- 1 | Create dune and dune-project files: 2 | $ bash ../write_dune_files.sh 3 | 4 | 5 | An simple record example 6 | ---------------------------------------------------------------------------- 7 | 8 | $ cat > test.ml <<'EOF' 9 | > type t = { x: int; y: int } 10 | > 11 | > let f = function 12 | > | {x=v;y=0} -> v 13 | > | {x=0;y=v} -> v 14 | > | {x;y} -> x+y 15 | > EOF 16 | 17 | 18 | $ export MUTAML_SEED=896745231 19 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 20 | Running mutaml instrumentation on "test.ml" 21 | Randomness seed: 896745231 Mutation rate: 50 GADTs enabled: true 22 | Created 3 mutations of test.ml 23 | Writing mutation info to test.muts 24 | 25 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 26 | let __is_mutaml_mutant__ m = 27 | match __MUTAML_MUTANT__ with 28 | | None -> false 29 | | Some mutant -> String.equal m mutant 30 | type t = { 31 | x: int ; 32 | y: int } 33 | let f = 34 | function 35 | | { x = v; y = 0 } when not (__is_mutaml_mutant__ "test:2") -> v 36 | | { x = 0; y = v } when not (__is_mutaml_mutant__ "test:1") -> v 37 | | { x; y } -> if __is_mutaml_mutant__ "test:0" then x - y else x + y 38 | 39 | 40 | -------------------------------------------------------------------------------- /test/instrumentation-tests/sequence.t: -------------------------------------------------------------------------------- 1 | Tests mutating sequence expressions 2 | =================================== 3 | 4 | $ bash ../write_dune_files.sh 5 | 6 | Set seed and (full) mutation rate as environment variables, for repeatability 7 | $ export MUTAML_SEED=896745231 8 | $ export MUTAML_MUT_RATE=100 9 | 10 | 11 | Test a sequence mutation: 12 | ------------------------- 13 | 14 | $ cat > test.ml <<'EOF' 15 | > let f () = 16 | > let c = ref 0 in 17 | > begin 18 | > incr c; 19 | > incr c; 20 | > incr c; 21 | > !c 22 | > end;; 23 | > assert (f() = 3) 24 | > EOF 25 | 26 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 27 | Running mutaml instrumentation on "test.ml" 28 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 29 | Created 4 mutations of test.ml 30 | Writing mutation info to test.muts 31 | 32 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 33 | let __is_mutaml_mutant__ m = 34 | match __MUTAML_MUTANT__ with 35 | | None -> false 36 | | Some mutant -> String.equal m mutant 37 | let f () = 38 | let c = ref (if __is_mutaml_mutant__ "test:0" then 1 else 0) in 39 | if __is_mutaml_mutant__ "test:3" then () else incr c; 40 | if __is_mutaml_mutant__ "test:2" then () else incr c; 41 | if __is_mutaml_mutant__ "test:1" then () else incr c; 42 | !c 43 | ;;assert ((f ()) = 3) 44 | 45 | 46 | Check that instrumentation hasn't changed the program's behaviour 47 | $ _build/default/test.bc 48 | 49 | 50 | $ MUTAML_MUTANT="test:0" _build/default/test.bc 51 | Fatal error: exception Assert_failure("test.ml", 9, 0) 52 | [2] 53 | 54 | $ MUTAML_MUTANT="test:1" _build/default/test.bc 55 | Fatal error: exception Assert_failure("test.ml", 9, 0) 56 | [2] 57 | 58 | $ MUTAML_MUTANT="test:2" _build/default/test.bc 59 | Fatal error: exception Assert_failure("test.ml", 9, 0) 60 | [2] 61 | 62 | $ MUTAML_MUTANT="test:3" _build/default/test.bc 63 | Fatal error: exception Assert_failure("test.ml", 9, 0) 64 | [2] 65 | 66 | 67 | $ mutaml-runner _build/default/test.bc 68 | read mut file test.muts 69 | Testing mutant test:0 ... failed 70 | Testing mutant test:1 ... failed 71 | Testing mutant test:2 ... failed 72 | Testing mutant test:3 ... failed 73 | Writing report data to mutaml-report.json 74 | 75 | 76 | 77 | 78 | Test uncaught sequence mutation: 79 | -------------------------------- 80 | 81 | $ cat > test.ml <<'EOF' 82 | > let f () = 83 | > let c = ref 0 in 84 | > begin 85 | > incr c; 86 | > incr c; 87 | > incr c; 88 | > !c 89 | > end;; 90 | > assert (f() > 0) 91 | > EOF 92 | 93 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 94 | Running mutaml instrumentation on "test.ml" 95 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 96 | Created 4 mutations of test.ml 97 | Writing mutation info to test.muts 98 | 99 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 100 | let __is_mutaml_mutant__ m = 101 | match __MUTAML_MUTANT__ with 102 | | None -> false 103 | | Some mutant -> String.equal m mutant 104 | let f () = 105 | let c = ref (if __is_mutaml_mutant__ "test:0" then 1 else 0) in 106 | if __is_mutaml_mutant__ "test:3" then () else incr c; 107 | if __is_mutaml_mutant__ "test:2" then () else incr c; 108 | if __is_mutaml_mutant__ "test:1" then () else incr c; 109 | !c 110 | ;;assert ((f ()) > 0) 111 | 112 | 113 | Check that instrumentation hasn't changed the program's behaviour 114 | $ _build/default/test.bc 115 | 116 | 117 | $ MUTAML_MUTANT="test:0" _build/default/test.bc 118 | 119 | $ MUTAML_MUTANT="test:1" _build/default/test.bc 120 | 121 | $ MUTAML_MUTANT="test:2" _build/default/test.bc 122 | 123 | $ MUTAML_MUTANT="test:3" _build/default/test.bc 124 | 125 | 126 | $ mutaml-runner _build/default/test.bc 127 | read mut file test.muts 128 | Testing mutant test:0 ... passed 129 | Testing mutant test:1 ... passed 130 | Testing mutant test:2 ... passed 131 | Testing mutant test:3 ... passed 132 | Writing report data to mutaml-report.json 133 | 134 | 135 | $ mutaml-report 136 | Attempting to read from mutaml-report.json... 137 | 138 | Mutaml report summary: 139 | ---------------------- 140 | 141 | target #mutations #failed #timeouts #passed 142 | ------------------------------------------------------------------------------------- 143 | test.ml 4 0.0% 0 0.0% 0 100.0% 4 144 | ===================================================================================== 145 | 146 | Mutation programs passing the test suite: 147 | ----------------------------------------- 148 | 149 | Mutation "test.ml-mutant0" passed (see "_mutations/test.ml-mutant0.output"): 150 | 151 | --- test.ml 152 | +++ test.ml-mutant0 153 | @@ -1,5 +1,5 @@ 154 | let f () = 155 | - let c = ref 0 in 156 | + let c = ref 1 in 157 | begin 158 | incr c; 159 | incr c; 160 | 161 | --------------------------------------------------------------------------- 162 | 163 | Mutation "test.ml-mutant1" passed (see "_mutations/test.ml-mutant1.output"): 164 | 165 | --- test.ml 166 | +++ test.ml-mutant1 167 | @@ -3,7 +3,6 @@ 168 | begin 169 | incr c; 170 | incr c; 171 | - incr c; 172 | !c 173 | end;; 174 | assert (f() > 0) 175 | 176 | --------------------------------------------------------------------------- 177 | 178 | Mutation "test.ml-mutant2" passed (see "_mutations/test.ml-mutant2.output"): 179 | 180 | --- test.ml 181 | +++ test.ml-mutant2 182 | @@ -2,8 +2,6 @@ 183 | let c = ref 0 in 184 | begin 185 | incr c; 186 | - incr c; 187 | - incr c; 188 | - !c 189 | + incr c; !c 190 | end;; 191 | assert (f() > 0) 192 | 193 | --------------------------------------------------------------------------- 194 | 195 | Mutation "test.ml-mutant3" passed (see "_mutations/test.ml-mutant3.output"): 196 | 197 | --- test.ml 198 | +++ test.ml-mutant3 199 | @@ -1,9 +1,4 @@ 200 | let f () = 201 | let c = ref 0 in 202 | - begin 203 | - incr c; 204 | - incr c; 205 | - incr c; 206 | - !c 207 | - end;; 208 | + incr c; incr c; !c;; 209 | assert (f() > 0) 210 | 211 | --------------------------------------------------------------------------- 212 | 213 | -------------------------------------------------------------------------------- /test/instrumentation-tests/simple_print.t: -------------------------------------------------------------------------------- 1 | Create dune and dune-project files: 2 | $ bash ../write_dune_files.sh 3 | 4 | Create a test.ml file with a few print M seed for randomized mutation 5 | M mutation threshold (chance/rate) 6 | s: 7 | $ cat > test.ml <<'EOF' 8 | > let () = print_string (string_of_bool true) 9 | > let () = print_newline() 10 | > let () = print_int 5 11 | > let () = print_newline() 12 | > EOF 13 | 14 | Confirm file creations 15 | $ ls dune* test.ml 16 | dune 17 | dune-project 18 | test.ml 19 | 20 | 21 | Set seed and (full) mutation rate as environment variables, for repeatability 22 | $ export MUTAML_SEED=896745231 23 | $ export MUTAML_MUT_RATE=100 24 | 25 | Compile with instrumentation and filter result: 26 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 27 | Running mutaml instrumentation on "test.ml" 28 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 29 | Created 2 mutations of test.ml 30 | Writing mutation info to test.muts 31 | 32 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 33 | let __is_mutaml_mutant__ m = 34 | match __MUTAML_MUTANT__ with 35 | | None -> false 36 | | Some mutant -> String.equal m mutant 37 | let () = 38 | print_string 39 | (string_of_bool (if __is_mutaml_mutant__ "test:0" then false else true)) 40 | let () = print_newline () 41 | let () = print_int (if __is_mutaml_mutant__ "test:1" then 6 else 5) 42 | let () = print_newline () 43 | 44 | 45 | $ ls _build/default 46 | mutaml-mut-files.txt 47 | test.bc 48 | test.ml 49 | test.muts 50 | test.pp.ml 51 | 52 | 53 | $ _build/default/test.bc 54 | true 55 | 5 56 | 57 | $ MUTAML_MUTANT="test:0" dune exec --no-build -- ./test.bc 58 | false 59 | 5 60 | 61 | $ MUTAML_MUTANT="test:1" dune exec --no-build -- ./test.bc 62 | true 63 | 6 64 | -------------------------------------------------------------------------------- /test/issue-attributes.t/run.t: -------------------------------------------------------------------------------- 1 | Let us try something: 2 | 3 | $ ls ../filter_dune_build.sh 4 | ../filter_dune_build.sh 5 | 6 | Create a file with a deriving show attribute https://github.com/jmid/mutaml/issues/28 7 | $ cat > test.ml << EOF 8 | > type some_type = A | B [@@deriving show {with_path = false}] 9 | > type another_type = C | D of some_type [@@deriving show {with_path = false}] 10 | > ;; 11 | > assert (show_another_type C = "C") 12 | > EOF 13 | 14 | Create the dune files: 15 | $ cat > dune-project << EOF 16 | > (lang dune 2.9) 17 | > EOF 18 | 19 | $ cat > dune <<'EOF' 20 | > (executable 21 | > (name test) 22 | > (preprocess (pps ppx_deriving.show)) 23 | > (instrumentation (backend mutaml)) 24 | > ) 25 | > EOF 26 | 27 | Check that files were created as expected: 28 | $ ls dune* test.ml 29 | dune 30 | dune-project 31 | test.ml 32 | 33 | Set seed and (full) mutation rate as environment variables, for repeatability 34 | $ export MUTAML_SEED=896745231 35 | $ export MUTAML_MUT_RATE=100 36 | 37 | $ ../filter_dune_build.sh ./test.exe --instrument-with mutaml 38 | Running mutaml instrumentation on "test.ml" 39 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 40 | Created 0 mutations of test.ml 41 | Writing mutation info to test.muts 42 | 43 | $ ls _build 44 | default 45 | log 46 | 47 | $ ls _build/default 48 | mutaml-mut-files.txt 49 | test.exe 50 | test.ml 51 | test.muts 52 | test.pp.ml 53 | 54 | $ mutaml-runner _build/default/test.exe 55 | read mut file test.muts 56 | Warning: No mutations were listed in test.muts 57 | Did not find any mutations across the files listed in mutaml-mut-files.txt 58 | [1] 59 | -------------------------------------------------------------------------------- /test/issue-newlines.t/run.t: -------------------------------------------------------------------------------- 1 | Let us try something: 2 | 3 | $ ls ../filter_dune_build.sh 4 | ../filter_dune_build.sh 5 | 6 | Create the central file with initial newline characters: 7 | $ cat > test.ml << EOF 8 | > 9 | > 10 | > (* here's a comment *) 11 | > 12 | > let add a b = a + b 13 | > ;; 14 | > assert (add 4 3 >= 0) 15 | > EOF 16 | 17 | Create the dune files: 18 | $ cat > dune-project << EOF 19 | > (lang dune 2.9) 20 | > EOF 21 | 22 | $ cat > dune <<'EOF' 23 | > (executable 24 | > (name test) 25 | > (ocamlc_flags -dsource) 26 | > (instrumentation (backend mutaml)) 27 | > ) 28 | > EOF 29 | 30 | Check that files were created as expected: 31 | $ ls dune* test.ml 32 | dune 33 | dune-project 34 | test.ml 35 | 36 | Set seed and (full) mutation rate as environment variables, for repeatability 37 | $ export MUTAML_SEED=896745231 38 | $ export MUTAML_MUT_RATE=100 39 | 40 | $ ../filter_dune_build.sh ./test.exe --instrument-with mutaml 41 | Running mutaml instrumentation on "test.ml" 42 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 43 | Created 1 mutation of test.ml 44 | Writing mutation info to test.muts 45 | 46 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 47 | let __is_mutaml_mutant__ m = 48 | match __MUTAML_MUTANT__ with 49 | | None -> false 50 | | Some mutant -> String.equal m mutant 51 | let add a b = if __is_mutaml_mutant__ "test:0" then a - b else a + b 52 | ;;assert ((add 4 3) >= 0) 53 | 54 | $ ls _build 55 | default 56 | log 57 | 58 | $ ls _build/default 59 | mutaml-mut-files.txt 60 | test.exe 61 | test.ml 62 | test.muts 63 | test.pp.ml 64 | 65 | $ mutaml-runner _build/default/test.exe 66 | read mut file test.muts 67 | Testing mutant test:0 ... passed 68 | Writing report data to mutaml-report.json 69 | 70 | $ mutaml-report 71 | Attempting to read from mutaml-report.json... 72 | 73 | Mutaml report summary: 74 | ---------------------- 75 | 76 | target #mutations #failed #timeouts #passed 77 | ------------------------------------------------------------------------------------- 78 | test.ml 1 0.0% 0 0.0% 0 100.0% 1 79 | ===================================================================================== 80 | 81 | Mutation programs passing the test suite: 82 | ----------------------------------------- 83 | 84 | Mutation "test.ml-mutant0" passed (see "_mutations/test.ml-mutant0.output"): 85 | 86 | --- test.ml 87 | +++ test.ml-mutant0 88 | @@ -2,6 +2,6 @@ 89 | 90 | (* here's a comment *) 91 | 92 | -let add a b = a + b 93 | +let add a b = a - b 94 | ;; 95 | assert (add 4 3 >= 0) 96 | 97 | --------------------------------------------------------------------------- 98 | 99 | 100 | 101 | 102 | 103 | $ ls _mutations 104 | test.ml-mutant0 105 | test.muts-mutant0.output 106 | 107 | 108 | Here's an example of a manual diff from the console: 109 | 110 | $ diff -u --label "test.ml" -u test.ml --label "test.ml-mutant0" _mutations/test.ml-mutant0 111 | --- test.ml 112 | +++ test.ml-mutant0 113 | @@ -2,6 +2,6 @@ 114 | 115 | (* here's a comment *) 116 | 117 | -let add a b = a + b 118 | +let add a b = a - b 119 | ;; 120 | assert (add 4 3 >= 0) 121 | [1] 122 | -------------------------------------------------------------------------------- /test/issue-pattern-match.t/run.t: -------------------------------------------------------------------------------- 1 | Let us try something: 2 | 3 | $ ls ../filter_dune_build.sh 4 | ../filter_dune_build.sh 5 | 6 | Create a file with a 'when' clause reduced from https://github.com/jmid/mutaml/issues/22 7 | $ cat > test.ml << EOF 8 | > let accepted_codes n = (n=42) 9 | > let make status = 10 | > let open Unix in 11 | > let exit_status = match status with 12 | > | WEXITED n when accepted_codes n -> Ok n 13 | > | WEXITED n -> Error (Printf.sprintf "Exited %n" n) 14 | > | WSIGNALED n -> Error (Printf.sprintf "Signaled %n" n) 15 | > | WSTOPPED _ -> assert false 16 | > in 17 | > exit_status 18 | > ;; 19 | > assert (make (Unix.WEXITED 0) = Error "Exited 0") 20 | > EOF 21 | 22 | Create the dune files: 23 | $ cat > dune-project << EOF 24 | > (lang dune 2.9) 25 | > EOF 26 | 27 | $ cat > dune <<'EOF' 28 | > (executable 29 | > (name test) 30 | > (ocamlc_flags -dsource) 31 | > (libraries unix) 32 | > (instrumentation (backend mutaml)) 33 | > ) 34 | > EOF 35 | 36 | Check that files were created as expected: 37 | $ ls dune* test.ml 38 | dune 39 | dune-project 40 | test.ml 41 | 42 | Set seed and (full) mutation rate as environment variables, for repeatability 43 | $ export MUTAML_SEED=896745231 44 | $ export MUTAML_MUT_RATE=100 45 | 46 | $ ../filter_dune_build.sh ./test.exe --instrument-with mutaml 47 | Running mutaml instrumentation on "test.ml" 48 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 49 | Created 2 mutations of test.ml 50 | Writing mutation info to test.muts 51 | 52 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 53 | let __is_mutaml_mutant__ m = 54 | match __MUTAML_MUTANT__ with 55 | | None -> false 56 | | Some mutant -> String.equal m mutant 57 | let accepted_codes n = n = (if __is_mutaml_mutant__ "test:0" then 43 else 42) 58 | let make status = 59 | let open Unix in 60 | let exit_status = 61 | ((match status with 62 | | WEXITED n when 63 | (accepted_codes n) && (not (__is_mutaml_mutant__ "test:1")) -> 64 | Ok n 65 | | WEXITED n -> Error (Printf.sprintf "Exited %n" n) 66 | | WSIGNALED n -> Error (Printf.sprintf "Signaled %n" n) 67 | | WSTOPPED _ -> assert false) 68 | [@ocaml.warning "-8"]) in 69 | exit_status 70 | ;;assert ((make (Unix.WEXITED 0)) = (Error "Exited 0")) 71 | 72 | $ ls _build 73 | default 74 | log 75 | 76 | $ ls _build/default 77 | mutaml-mut-files.txt 78 | test.exe 79 | test.ml 80 | test.muts 81 | test.pp.ml 82 | 83 | $ mutaml-runner _build/default/test.exe 84 | read mut file test.muts 85 | Testing mutant test:0 ... passed 86 | Testing mutant test:1 ... passed 87 | Writing report data to mutaml-report.json 88 | 89 | $ mutaml-report 90 | Attempting to read from mutaml-report.json... 91 | 92 | Mutaml report summary: 93 | ---------------------- 94 | 95 | target #mutations #failed #timeouts #passed 96 | ------------------------------------------------------------------------------------- 97 | test.ml 2 0.0% 0 0.0% 0 100.0% 2 98 | ===================================================================================== 99 | 100 | Mutation programs passing the test suite: 101 | ----------------------------------------- 102 | 103 | Mutation "test.ml-mutant0" passed (see "_mutations/test.ml-mutant0.output"): 104 | 105 | --- test.ml 106 | +++ test.ml-mutant0 107 | @@ -1,4 +1,4 @@ 108 | -let accepted_codes n = (n=42) 109 | +let accepted_codes n = (n=43) 110 | let make status = 111 | let open Unix in 112 | let exit_status = match status with 113 | 114 | --------------------------------------------------------------------------- 115 | 116 | Mutation "test.ml-mutant1" passed (see "_mutations/test.ml-mutant1.output"): 117 | 118 | --- test.ml 119 | +++ test.ml-mutant1 120 | @@ -2,7 +2,6 @@ 121 | let make status = 122 | let open Unix in 123 | let exit_status = match status with 124 | - | WEXITED n when accepted_codes n -> Ok n 125 | | WEXITED n -> Error (Printf.sprintf "Exited %n" n) 126 | | WSIGNALED n -> Error (Printf.sprintf "Signaled %n" n) 127 | | WSTOPPED _ -> assert false 128 | 129 | --------------------------------------------------------------------------- 130 | 131 | 132 | 133 | 134 | 135 | $ ls _mutations 136 | test.ml-mutant0 137 | test.ml-mutant1 138 | test.muts-mutant0.output 139 | test.muts-mutant1.output 140 | -------------------------------------------------------------------------------- /test/issue-stdlib-equal.t/run.t: -------------------------------------------------------------------------------- 1 | Let us try something: 2 | 3 | $ ls ../filter_dune_build.sh 4 | ../filter_dune_build.sh 5 | 6 | Create the central file overriding polymorphic equality: 7 | $ cat > test.ml << EOF 8 | > let (=) = Int.equal 9 | > 10 | > let add a b = a + b 11 | > ;; 12 | > assert (add 4 3 >= 0) 13 | > EOF 14 | 15 | Create the dune files: 16 | $ cat > dune-project << EOF 17 | > (lang dune 2.9) 18 | > EOF 19 | 20 | $ cat > dune <<'EOF' 21 | > (executable 22 | > (name test) 23 | > (ocamlc_flags -dsource) 24 | > (instrumentation (backend mutaml)) 25 | > ) 26 | > EOF 27 | 28 | Check that files were created as expected: 29 | $ ls dune* test.ml 30 | dune 31 | dune-project 32 | test.ml 33 | 34 | Set seed and (full) mutation rate as environment variables, for repeatability 35 | $ export MUTAML_SEED=896745231 36 | $ export MUTAML_MUT_RATE=100 37 | 38 | $ ../filter_dune_build.sh ./test.exe --instrument-with mutaml 39 | Running mutaml instrumentation on "test.ml" 40 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 41 | Created 1 mutation of test.ml 42 | Writing mutation info to test.muts 43 | 44 | let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT" 45 | let __is_mutaml_mutant__ m = 46 | match __MUTAML_MUTANT__ with 47 | | None -> false 48 | | Some mutant -> String.equal m mutant 49 | let (=) = Int.equal 50 | let add a b = if __is_mutaml_mutant__ "test:0" then a - b else a + b 51 | ;;assert ((add 4 3) >= 0) 52 | 53 | $ ls _build 54 | default 55 | log 56 | 57 | $ ls _build/default 58 | mutaml-mut-files.txt 59 | test.exe 60 | test.ml 61 | test.muts 62 | test.pp.ml 63 | 64 | $ mutaml-runner _build/default/test.exe 65 | read mut file test.muts 66 | Testing mutant test:0 ... passed 67 | Writing report data to mutaml-report.json 68 | 69 | $ mutaml-report 70 | Attempting to read from mutaml-report.json... 71 | 72 | Mutaml report summary: 73 | ---------------------- 74 | 75 | target #mutations #failed #timeouts #passed 76 | ------------------------------------------------------------------------------------- 77 | test.ml 1 0.0% 0 0.0% 0 100.0% 1 78 | ===================================================================================== 79 | 80 | Mutation programs passing the test suite: 81 | ----------------------------------------- 82 | 83 | Mutation "test.ml-mutant0" passed (see "_mutations/test.ml-mutant0.output"): 84 | 85 | --- test.ml 86 | +++ test.ml-mutant0 87 | @@ -1,5 +1,5 @@ 88 | let (=) = Int.equal 89 | 90 | -let add a b = a + b 91 | +let add a b = a - b 92 | ;; 93 | assert (add 4 3 >= 0) 94 | 95 | --------------------------------------------------------------------------- 96 | 97 | -------------------------------------------------------------------------------- /test/negative-tests/ppx-negtests.t: -------------------------------------------------------------------------------- 1 | Create a test.ml file with a few prints: 2 | $ cat > test.ml <<'EOF' 3 | > let () = print_int 10 4 | > let () = print_newline() 5 | > EOF 6 | 7 | Create a dune-project file: 8 | $ echo "(lang dune 2.9)" > dune-project 9 | 10 | ----------------------------------------------------------------------- 11 | Test invalid environment variables 12 | ----------------------------------------------------------------------- 13 | 14 | $ cat > dune <<'EOF' 15 | > (executable 16 | > (name test) 17 | > (modes byte) 18 | > (instrumentation (backend mutaml)) 19 | > ) 20 | > EOF 21 | 22 | $ export MUTAML_GADT=sometimes 23 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 | head | sed -e 's/ppx\/[^\/]*\/ppx\.exe/ppx\/path\/ppx\.exe/g' 24 | File "dune", line 4, characters 1-35: 25 | 4 | (instrumentation (backend mutaml)) 26 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 27 | Invalid gadt string: sometimes 28 | 29 | 30 | $ dune clean 31 | $ unset MUTAML_GADT 32 | $ export MUTAML_SEED=-4611686018427387905 33 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 | head | sed -e 's/ppx\/[^\/]*\/ppx\.exe/ppx\/path\/ppx\.exe/g' 34 | File "dune", line 4, characters 1-35: 35 | 4 | (instrumentation (backend mutaml)) 36 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 37 | Invalid randomness seed: -4611686018427387905 38 | 39 | 40 | $ dune clean 41 | $ export MUTAML_SEED=4611686018427387904 42 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 | head | sed -e 's/ppx\/[^\/]*\/ppx\.exe/ppx\/path\/ppx\.exe/g' 43 | File "dune", line 4, characters 1-35: 44 | 4 | (instrumentation (backend mutaml)) 45 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 46 | Invalid randomness seed: 4611686018427387904 47 | 48 | 49 | $ dune clean 50 | $ export MUTAML_SEED=12likeREEEAALLLYrandom34 51 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 | head | sed -e 's/ppx\/[^\/]*\/ppx\.exe/ppx\/path\/ppx\.exe/g' 52 | File "dune", line 4, characters 1-35: 53 | 4 | (instrumentation (backend mutaml)) 54 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 55 | Invalid randomness seed: 12likeREEEAALLLYrandom34 56 | 57 | 58 | $ dune clean 59 | $ unset MUTAML_SEED 60 | $ export MUTAML_MUT_RATE=110 61 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 | head | sed -e 's/ppx\/[^\/]*\/ppx\.exe/ppx\/path\/ppx\.exe/g' 62 | File "dune", line 4, characters 1-35: 63 | 4 | (instrumentation (backend mutaml)) 64 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 65 | Invalid mutation rate: 110 66 | 67 | 68 | $ dune clean 69 | $ export MUTAML_MUT_RATE=-10 70 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 | head | sed -e 's/ppx\/[^\/]*\/ppx\.exe/ppx\/path\/ppx\.exe/g' 71 | File "dune", line 4, characters 1-35: 72 | 4 | (instrumentation (backend mutaml)) 73 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 74 | Invalid mutation rate: -10 75 | 76 | 77 | $ dune clean 78 | $ export MUTAML_MUT_RATE=always 79 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 | head | sed -e 's/ppx\/[^\/]*\/ppx\.exe/ppx\/path\/ppx\.exe/g' 80 | File "dune", line 4, characters 1-35: 81 | 4 | (instrumentation (backend mutaml)) 82 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 83 | Invalid mutation rate: always 84 | 85 | 86 | $ unset MUTAML_MUT_RATE 87 | 88 | ----------------------------------------------------------------------- 89 | Create a dune file passing an invalid mutation rate 90 | Instrument and check that it is rejected 91 | ----------------------------------------------------------------------- 92 | 93 | $ cat > dune <<'EOF' 94 | > (executable 95 | > (name test) 96 | > (modes byte) 97 | > (instrumentation (backend mutaml -mut-rate 110)) 98 | > ) 99 | > EOF 100 | 101 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 | head | sed -e 's/ppx\/[^\/]*\/ppx\.exe/ppx\/path\/ppx\.exe/g' 102 | File "dune", line 4, characters 1-49: 103 | 4 | (instrumentation (backend mutaml -mut-rate 110)) 104 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 105 | .ppx/path/ppx.exe: Invalid mutation rate: 110. 106 | ppx.exe [extra_args] [] 107 | -as-ppx Run as a -ppx rewriter (must be the first argument) 108 | --as-ppx Same as -as-ppx 109 | -as-pp Shorthand for: -dump-ast -embed-errors 110 | --as-pp Same as -as-pp 111 | -o Output file (use '-' for stdout) 112 | 113 | 114 | ----------------------------------------------------------------------- 115 | Create a dune file passing an negative mutation rate 116 | Instrument and check that it is rejected 117 | ----------------------------------------------------------------------- 118 | 119 | $ cat > dune <<'EOF' 120 | > (executable 121 | > (name test) 122 | > (modes byte) 123 | > (instrumentation (backend mutaml -mut-rate -10)) 124 | > ) 125 | > EOF 126 | 127 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 | head | sed -e 's/ppx\/[^\/]*\/ppx\.exe/ppx\/path\/ppx\.exe/g' 128 | File "dune", line 4, characters 1-49: 129 | 4 | (instrumentation (backend mutaml -mut-rate -10)) 130 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 131 | .ppx/path/ppx.exe: Invalid mutation rate: -10. 132 | ppx.exe [extra_args] [] 133 | -as-ppx Run as a -ppx rewriter (must be the first argument) 134 | --as-ppx Same as -as-ppx 135 | -as-pp Shorthand for: -dump-ast -embed-errors 136 | --as-pp Same as -as-pp 137 | -o Output file (use '-' for stdout) 138 | 139 | 140 | ----------------------------------------------------------------------- 141 | Create a dune file passing an invalid mutation rate 142 | Instrument and check that it is rejected 143 | ----------------------------------------------------------------------- 144 | 145 | $ cat > dune <<'EOF' 146 | > (executable 147 | > (name test) 148 | > (modes byte) 149 | > (instrumentation (backend mutaml -mut-rate eeeEEEEEXTREMELYHIGH)) 150 | > ) 151 | > EOF 152 | 153 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 | head | sed -e 's/ppx\/[^\/]*\/ppx\.exe/ppx\/path\/ppx\.exe/g' 154 | File "dune", line 4, characters 1-66: 155 | 4 | (instrumentation (backend mutaml -mut-rate eeeEEEEEXTREMELYHIGH)) 156 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 157 | .ppx/path/ppx.exe: wrong argument 'eeeEEEEEXTREMELYHIGH'; option '-mut-rate' expects an integer. 158 | ppx.exe [extra_args] [] 159 | -as-ppx Run as a -ppx rewriter (must be the first argument) 160 | --as-ppx Same as -as-ppx 161 | -as-pp Shorthand for: -dump-ast -embed-errors 162 | --as-pp Same as -as-pp 163 | -o Output file (use '-' for stdout) 164 | 165 | 166 | ----------------------------------------------------------------------- 167 | Create a dune file passing an invalid seed (max_int + 1) 168 | Instrument and check that it is rejected 169 | ----------------------------------------------------------------------- 170 | 171 | $ cat > dune <<'EOF' 172 | > (executable 173 | > (name test) 174 | > (modes byte) 175 | > (instrumentation (backend mutaml -seed 4611686018427387904)) 176 | > ) 177 | > EOF 178 | 179 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 | head | sed -e 's/ppx\/[^\/]*\/ppx\.exe/ppx\/path\/ppx\.exe/g' 180 | File "dune", line 4, characters 1-61: 181 | 4 | (instrumentation (backend mutaml -seed 4611686018427387904)) 182 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 183 | .ppx/path/ppx.exe: wrong argument '4611686018427387904'; option '-seed' expects an integer. 184 | ppx.exe [extra_args] [] 185 | -as-ppx Run as a -ppx rewriter (must be the first argument) 186 | --as-ppx Same as -as-ppx 187 | -as-pp Shorthand for: -dump-ast -embed-errors 188 | --as-pp Same as -as-pp 189 | -o Output file (use '-' for stdout) 190 | 191 | 192 | ----------------------------------------------------------------------- 193 | Create a dune file passing an invalid seed 194 | Instrument and check that it is rejected 195 | ----------------------------------------------------------------------- 196 | 197 | $ cat > dune <<'EOF' 198 | > (executable 199 | > (name test) 200 | > (modes byte) 201 | > (instrumentation (backend mutaml -seed 324random345)) 202 | > ) 203 | > EOF 204 | 205 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 | head | sed -e 's/ppx\/[^\/]*\/ppx\.exe/ppx\/path\/ppx\.exe/g' 206 | File "dune", line 4, characters 1-54: 207 | 4 | (instrumentation (backend mutaml -seed 324random345)) 208 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 209 | .ppx/path/ppx.exe: wrong argument '324random345'; option '-seed' expects an integer. 210 | ppx.exe [extra_args] [] 211 | -as-ppx Run as a -ppx rewriter (must be the first argument) 212 | --as-ppx Same as -as-ppx 213 | -as-pp Shorthand for: -dump-ast -embed-errors 214 | --as-pp Same as -as-pp 215 | -o Output file (use '-' for stdout) 216 | 217 | 218 | ----------------------------------------------------------------------- 219 | Create a dune file passing --help 220 | Instrument and check that it was received 221 | ----------------------------------------------------------------------- 222 | 223 | $ cat > dune <<'EOF' 224 | > (executable 225 | > (name test) 226 | > (modes byte) 227 | > (instrumentation (backend mutaml --help)) 228 | > ) 229 | > EOF 230 | 231 | $ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 | grep -v "use-compiler-pp" | grep -v "no-merge" | grep -v "Embed errors" | grep -v "keywords" 232 | ppx.exe [extra_args] [] 233 | -as-ppx Run as a -ppx rewriter (must be the first argument) 234 | --as-ppx Same as -as-ppx 235 | -as-pp Shorthand for: -dump-ast -embed-errors 236 | --as-pp Same as -as-pp 237 | -o Output file (use '-' for stdout) 238 | - Read input from stdin 239 | -dump-ast Dump the marshaled ast to the output file instead of pretty-printing it 240 | --dump-ast Same as -dump-ast 241 | -dparsetree Print the parsetree (same as ocamlc -dparsetree) 242 | -null Produce no output, except for errors 243 | -impl Treat the input as a .ml file 244 | --impl Same as -impl 245 | -intf Treat the input as a .mli file 246 | --intf Same as -intf 247 | -debug-attribute-drop Debug attribute dropping 248 | -print-transformations Print linked-in code transformations, in the order they are applied 249 | -print-passes Print the actual passes over the whole AST in the order they are applied 250 | -ite-check (no effect -- kept for compatibility) 251 | -pp Pipe sources through preprocessor (incompatible with -as-ppx) 252 | -reconcile (WIP) Pretty print the output using a mix of the input source and the generated code 253 | -reconcile-with-comments (WIP) same as -reconcile but uses comments to enclose the generated code 254 | -no-color Don't use colors when printing errors 255 | -diff-cmd Diff command when using code expectations (use - to disable diffing) 256 | -pretty Instruct code generators to improve the prettiness of the generated code 257 | -styler Code styler 258 | -output-metadata FILE Where to store the output metadata 259 | -corrected-suffix SUFFIX Suffix to append to corrected files 260 | -loc-filename File name to use in locations 261 | -reserve-namespace Mark the given namespace as reserved 262 | -no-check Disable checks (unsafe) 263 | -check Enable checks 264 | -no-check-on-extensions Disable checks on extension point only 265 | -check-on-extensions Enable checks on extension point only 266 | -no-locations-check Disable locations check only 267 | -locations-check Enable locations check only 268 | -apply Apply these transformations in order (comma-separated list) 269 | -dont-apply Exclude these transformations 270 | -cookie NAME=EXPR Set the cookie NAME to EXPR 271 | --cookie Same as -cookie 272 | -seed Set randomness seed for mutaml's instrumentation 273 | -mut-rate Set probability in % of mutating a syntax tree node (default: 50%) 274 | -gadt Allow only pattern mutations compatible with GADTs (default: true) 275 | -help Display this list of options 276 | --help Display this list of options 277 | File "dune", line 4, characters 1-42: 278 | 4 | (instrumentation (backend mutaml --help)) 279 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 280 | Error: Rule failed to generate the following targets: 281 | - test.pp.ml 282 | -------------------------------------------------------------------------------- /test/negative-tests/report-negtests.t: -------------------------------------------------------------------------------- 1 | Check that report tool fails without finding JSON file: 2 | $ mutaml-report 3 | Attempting to read from mutaml-report.json... 4 | Could not open file mutaml-report.json: No such file or directory 5 | [1] 6 | 7 | Check that report tool fails without finding another inexisting JSON file: 8 | $ mutaml-report foobar.json 9 | Attempting to read from foobar.json... 10 | Could not open file foobar.json: No such file or directory 11 | [1] 12 | 13 | Create a non-JSON file: 14 | $ cat > invalid-input.txt <<'EOF' 15 | > - finn : 42th birthday 16 | > - remember to buy toiletpaper 17 | > - æøå 18 | > EOF 19 | 20 | Check that it was created: 21 | $ ls invalid-input.txt 22 | invalid-input.txt 23 | 24 | Try to parse `invalid-input.txt` as JSON: 25 | $ mutaml-report invalid-input.txt 26 | Attempting to read from invalid-input.txt... 27 | Could not parse JSON in invalid-input.txt: Invalid JSON 28 | [1] 29 | 30 | Create a JSON file in the wrong format: 31 | $ cat > mydoc.json <<'EOF' 32 | > { "finn" : 42; 33 | > "john" : [1;2;3;true] 34 | > } 35 | > EOF 36 | 37 | Check that it was created: 38 | $ ls mydoc.json 39 | mydoc.json 40 | 41 | Now confirm that it is rejected by the report tool: 42 | $ mutaml-report mydoc.json 43 | Attempting to read from mydoc.json... 44 | Could not parse JSON in mydoc.json: Invalid JSON 45 | [1] 46 | -------------------------------------------------------------------------------- /test/negative-tests/runner-negtests.t: -------------------------------------------------------------------------------- 1 | Check that report tool fails when run without a test command: 2 | $ mutaml-runner 3 | Usage: mutaml-runner [options] 4 | [1] 5 | 6 | Try to supply an invalid command as argument, but still missing a mutation file: 7 | $ mutaml-runner scooby-doo.sh 8 | Could not read file mutaml-mut-files.txt - _build/default/mutaml-mut-files.txt: No such file or directory 9 | [1] 10 | 11 | Now create the missing mutation file: 12 | $ mkdir -p _build/default 13 | $ touch _build/default/mutaml-mut-files.txt 14 | and try again: 15 | $ mutaml-runner scooby-doo.sh 16 | No files were listed in mutaml-mut-files.txt 17 | [1] 18 | 19 | Try passing a non-existing muts-file: 20 | $ mutaml-runner --muts somefile.muts scooby-doo.sh 21 | Could not read file somefile.muts - _build/default/somefile.muts: No such file or directory 22 | [1] 23 | 24 | Create a mutation file with a non-existing entry: 25 | $ cat > _build/default/mutaml-mut-files.txt <<'EOF' 26 | > somefile.muts 27 | > EOF 28 | and try again: 29 | $ mutaml-runner scooby-doo.sh 30 | read mut file somefile.muts 31 | Could not read file somefile.muts - _build/default/somefile.muts: No such file or directory 32 | [1] 33 | 34 | Create a corresponding mutation file with an empty list of mutations: 35 | $ cat > _build/default/somefile.muts <<'EOF' 36 | > [] 37 | > EOF 38 | 39 | Check that it was created: 40 | $ ls _build/default 41 | mutaml-mut-files.txt 42 | somefile.muts 43 | 44 | Now confirm that it is rejected by the report tool: 45 | $ mutaml-runner scooby-doo.sh 46 | read mut file somefile.muts 47 | Warning: No mutations were listed in somefile.muts 48 | Did not find any mutations across the files listed in mutaml-mut-files.txt 49 | [1] 50 | 51 | Create a corresponding mutation file with a dummy mutation: 52 | $ cat > _build/default/somefile.muts <<'EOF' 53 | > [{ "number" : 0, 54 | > "repl" : "false", 55 | > "loc" : { 56 | > "loc_start" : { "pos_fname" : "somefile.ml", "pos_lnum" : 1, "pos_bol" : 1, "pos_cnum" : 1 }, 57 | > "loc_end" : { "pos_fname" : "somefile.ml", "pos_lnum" : 2, "pos_bol" : 2, "pos_cnum" : 2 }, 58 | > "loc_ghost" : false 59 | > } 60 | > }] 61 | > EOF 62 | Now try running again with a broken command: 63 | $ mutaml-runner scooby-doo.sh 64 | read mut file somefile.muts 65 | Testing mutant somefile:0 ... Command not found: failed to run the test command "scooby-doo.sh" 66 | [1] 67 | 68 | 69 | 70 | Run with an unknown build context passed as environment variable: 71 | $ export MUTAML_BUILD_CONTEXT="_build/in-a-galaxy-far-far-away" 72 | $ mutaml-runner true 73 | Could not read file mutaml-mut-files.txt - _build/in-a-galaxy-far-far-away/mutaml-mut-files.txt: No such file or directory 74 | [1] 75 | 76 | 77 | 78 | Run with an unknown build context passed as command line option: 79 | $ mutaml-runner --build-context _build/foofoo true 80 | Could not read file mutaml-mut-files.txt - _build/foofoo/mutaml-mut-files.txt: No such file or directory 81 | [1] 82 | -------------------------------------------------------------------------------- /test/testproj-1-module.t/lib.ml: -------------------------------------------------------------------------------- 1 | module Random = Random4 2 | 3 | let rec fac n = match n with 4 | | 0 -> 1 5 | | _ -> n * fac (n-1) 6 | 7 | let rec sum n = match n with 8 | | 0 -> 0 9 | | _ -> n + sum (n-1) 10 | 11 | let greeting s = "Hello, " ^ s 12 | 13 | (* Monte Carlo simulation 14 | 15 | inside ~ pi * r * r 16 | -------- ~ ---------- with r=1 17 | total 4 18 | 19 | => pi ~ 4 * inside / total 20 | *) 21 | 22 | let pi total = 23 | let rec loop n inside = 24 | if n = 0 then 25 | 4. *. (float_of_int inside /. float_of_int total) 26 | else 27 | let x = 1.0 -. Random.float 2.0 in 28 | let y = 1.0 -. Random.float 2.0 in 29 | if x *. x +. y *. y <= 1. 30 | then loop (n-1) (inside+1) 31 | else loop (n-1) (inside) 32 | in 33 | loop total 0 34 | -------------------------------------------------------------------------------- /test/testproj-1-module.t/main.ml: -------------------------------------------------------------------------------- 1 | let print_usage_and_exit () = 2 | let () = Printf.printf "Usage: %s something somenumber\n" (Sys.argv.(0)) in 3 | exit 1 4 | 5 | let _ = 6 | if Array.length Sys.argv != 3 7 | then 8 | print_usage_and_exit () 9 | else 10 | try 11 | let s = Sys.argv.(1) in 12 | let i = int_of_string Sys.argv.(2) in 13 | let () = Printf.printf "%s\n" (Lib.greeting s) in 14 | let () = Printf.printf "Factorial of %i is %i\n" i (Lib.fac i) in 15 | let () = Printf.printf "Sum of 1+...+%i is %i\n" i (Lib.sum i) in 16 | let () = Random.self_init () in 17 | let () = Printf.printf "Pi approximation: %f\n" (Lib.pi (i * 1_000_000)) in 18 | () 19 | with (Failure _) -> 20 | print_usage_and_exit () 21 | 22 | -------------------------------------------------------------------------------- /test/testproj-1-module.t/ounittest.ml: -------------------------------------------------------------------------------- 1 | (* These tests use OUnit *) 2 | open OUnit2 3 | 4 | let tests = "Code test suite" >::: [ 5 | "fac5" >:: (fun _ -> assert_equal 120 (Lib.fac 5)); 6 | "sum5" >:: (fun _ -> assert_equal 15 (Lib.sum 5)); 7 | "greetFinn" >:: (fun _ -> assert_equal "Hello, Finn" (Lib.greeting "Finn")); 8 | "pi-10mill" >:: (fun _ -> 9 | let pi = Lib.pi 10_000 in 10 | OUnit2.assert_bool "3.14 <= pi" (3.14 <= pi); 11 | OUnit2.assert_bool "pi <= 3.143" (pi <= 3.143)); 12 | ] 13 | 14 | let () = run_test_tt_main tests 15 | -------------------------------------------------------------------------------- /test/testproj-2-modules.t/run.t: -------------------------------------------------------------------------------- 1 | $ ls src test 2 | src: 3 | dune 4 | lib1.ml 5 | lib2.ml 6 | main.ml 7 | 8 | test: 9 | dune 10 | ounittest.ml 11 | 12 | 13 | $ cat > dune-project << EOF 14 | > (lang dune 2.9) 15 | > EOF 16 | 17 | Set seed and (full) mutation rate as environment variables, for repeatability 18 | $ export MUTAML_SEED=896745231 19 | $ export MUTAML_MUT_RATE=100 20 | 21 | $ bash ../filter_dune_build.sh test/ounittest.exe --instrument-with mutaml 22 | Running mutaml instrumentation on "src/lib1.ml" 23 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 24 | Created 3 mutations of src/lib1.ml 25 | Writing mutation info to src/lib1.muts 26 | Running mutaml instrumentation on "src/lib2.ml" 27 | Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true 28 | Created 6 mutations of src/lib2.ml 29 | Writing mutation info to src/lib2.muts 30 | 31 | $ mutaml-runner _build/default/test/ounittest.exe 32 | read mut file src/lib1.muts 33 | read mut file src/lib2.muts 34 | Testing mutant src/lib1:0 ... failed 35 | Testing mutant src/lib1:1 ... failed 36 | Testing mutant src/lib1:2 ... failed 37 | Testing mutant src/lib2:0 ... passed 38 | Testing mutant src/lib2:1 ... passed 39 | Testing mutant src/lib2:2 ... passed 40 | Testing mutant src/lib2:3 ... failed 41 | Testing mutant src/lib2:4 ... failed 42 | Testing mutant src/lib2:5 ... failed 43 | Writing report data to mutaml-report.json 44 | 45 | $ mutaml-report 46 | Attempting to read from mutaml-report.json... 47 | 48 | Mutaml report summary: 49 | ---------------------- 50 | 51 | target #mutations #failed #timeouts #passed 52 | ------------------------------------------------------------------------------------- 53 | src/lib1.ml 3 100.0% 3 0.0% 0 0.0% 0 54 | src/lib2.ml 6 50.0% 3 0.0% 0 50.0% 3 55 | ------------------------------------------------------------------------------------- 56 | total 9 66.7% 6 0.0% 0 33.3% 3 57 | ===================================================================================== 58 | 59 | Mutation programs passing the test suite: 60 | ----------------------------------------- 61 | 62 | Mutation "src/lib2.ml-mutant0" passed (see "_mutations/src/lib2.ml-mutant0.output"): 63 | 64 | --- src/lib2.ml 65 | +++ src/lib2.ml-mutant0 66 | @@ -1,5 +1,5 @@ 67 | let rec fac n = match n with 68 | - | 0 -> 1 69 | + | 0 -> 0 70 | | _ -> n * fac (n-1) 71 | 72 | let rec sum n = match n with 73 | 74 | --------------------------------------------------------------------------- 75 | 76 | Mutation "src/lib2.ml-mutant1" passed (see "_mutations/src/lib2.ml-mutant1.output"): 77 | 78 | --- src/lib2.ml 79 | +++ src/lib2.ml-mutant1 80 | @@ -1,6 +1,6 @@ 81 | let rec fac n = match n with 82 | | 0 -> 1 83 | - | _ -> n * fac (n-1) 84 | + | _ -> n * fac n 85 | 86 | let rec sum n = match n with 87 | | 0 -> 0 88 | 89 | --------------------------------------------------------------------------- 90 | 91 | Mutation "src/lib2.ml-mutant2" passed (see "_mutations/src/lib2.ml-mutant2.output"): 92 | 93 | --- src/lib2.ml 94 | +++ src/lib2.ml-mutant2 95 | @@ -1,6 +1,6 @@ 96 | let rec fac n = match n with 97 | | 0 -> 1 98 | - | _ -> n * fac (n-1) 99 | + | _ -> n + (fac (n - 1)) 100 | 101 | let rec sum n = match n with 102 | | 0 -> 0 103 | 104 | --------------------------------------------------------------------------- 105 | 106 | Now try testing only the mutations in src/lib1.muts: 107 | 108 | $ mutaml-runner --muts src/lib1.muts _build/default/test/ounittest.exe 109 | Testing mutant src/lib1:0 ... failed 110 | Testing mutant src/lib1:1 ... failed 111 | Testing mutant src/lib1:2 ... failed 112 | Writing report data to mutaml-report.json 113 | 114 | And report a summary: 115 | 116 | $ mutaml-report 117 | Attempting to read from mutaml-report.json... 118 | 119 | Mutaml report summary: 120 | ---------------------- 121 | 122 | target #mutations #failed #timeouts #passed 123 | ------------------------------------------------------------------------------------- 124 | src/lib1.ml 3 100.0% 3 0.0% 0 0.0% 0 125 | ===================================================================================== 126 | 127 | 128 | Now try the same for src/lib2.muts: 129 | 130 | $ mutaml-runner --muts src/lib2.muts _build/default/test/ounittest.exe 131 | Testing mutant src/lib2:0 ... passed 132 | Testing mutant src/lib2:1 ... passed 133 | Testing mutant src/lib2:2 ... passed 134 | Testing mutant src/lib2:3 ... failed 135 | Testing mutant src/lib2:4 ... failed 136 | Testing mutant src/lib2:5 ... failed 137 | Writing report data to mutaml-report.json 138 | 139 | And report a diff-free summary: 140 | 141 | $ mutaml-report --no-diff 142 | Attempting to read from mutaml-report.json... 143 | 144 | Mutaml report summary: 145 | ---------------------- 146 | 147 | target #mutations #failed #timeouts #passed 148 | ------------------------------------------------------------------------------------- 149 | src/lib2.ml 6 50.0% 3 0.0% 0 50.0% 3 150 | ===================================================================================== 151 | 152 | Mutation programs passing the test suite: 153 | ----------------------------------------- 154 | 155 | Mutation "src/lib2.ml-mutant0" passed (see "_mutations/src/lib2.ml-mutant0.output") 156 | Mutation "src/lib2.ml-mutant1" passed (see "_mutations/src/lib2.ml-mutant1.output") 157 | Mutation "src/lib2.ml-mutant2" passed (see "_mutations/src/lib2.ml-mutant2.output") 158 | -------------------------------------------------------------------------------- /test/testproj-2-modules.t/src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name lib1) 3 | (modules lib1) 4 | (instrumentation (backend mutaml)) 5 | ) 6 | 7 | (library 8 | (name lib2) 9 | (modules lib2) 10 | (instrumentation (backend mutaml)) 11 | ) 12 | 13 | (executable 14 | (name main) 15 | (modules main) 16 | (libraries lib1 lib2) 17 | (promote (until-clean) (into ..)) 18 | ) 19 | -------------------------------------------------------------------------------- /test/testproj-2-modules.t/src/lib1.ml: -------------------------------------------------------------------------------- 1 | let rec fac n = match n with 2 | | 0 -> 1 3 | | _ -> n * fac (n-1) 4 | -------------------------------------------------------------------------------- /test/testproj-2-modules.t/src/lib2.ml: -------------------------------------------------------------------------------- 1 | let rec fac n = match n with 2 | | 0 -> 1 3 | | _ -> n * fac (n-1) 4 | 5 | let rec sum n = match n with 6 | | 0 -> 0 7 | | _ -> n + sum (n-1) 8 | -------------------------------------------------------------------------------- /test/testproj-2-modules.t/src/main.ml: -------------------------------------------------------------------------------- 1 | let print_usage_and_exit () = 2 | let () = Printf.printf "Usage: %s somenumber\n" (Sys.argv.(0)) in 3 | exit 1 4 | 5 | let _ = 6 | if Array.length Sys.argv != 2 7 | then 8 | print_usage_and_exit () 9 | else 10 | try 11 | let i = int_of_string Sys.argv.(1) in 12 | let () = Printf.printf "Factorial of %i is %i\n" i (Lib1.fac i) in 13 | let () = Printf.printf "Sum of 1+...+%i is %i\n" i (Lib2.sum i) in 14 | () 15 | with (Failure _) -> 16 | print_usage_and_exit () 17 | 18 | -------------------------------------------------------------------------------- /test/testproj-2-modules.t/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name ounittest) 3 | (libraries lib1 lib2 ounit2) 4 | ) 5 | -------------------------------------------------------------------------------- /test/testproj-2-modules.t/test/ounittest.ml: -------------------------------------------------------------------------------- 1 | (* These tests use OUnit *) 2 | open OUnit2 3 | 4 | let tests = "Code test suite" >::: [ 5 | "fac5" >:: (fun _ -> assert_equal 120 (Lib1.fac 5)); 6 | "sum5" >:: (fun _ -> assert_equal 15 (Lib2.sum 5)); 7 | (*"fac-equal" >:: (fun _ -> assert_equal (Lib1.fac 5) (Lib2.fac 5));*) 8 | ] 9 | 10 | let () = run_test_tt_main tests 11 | -------------------------------------------------------------------------------- /test/write_dune_files.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | #Create dune-project file 4 | cat > dune-project << EOF 5 | (lang dune 2.9) 6 | EOF 7 | 8 | #Create a dune file enabling instrumentation 9 | cat > dune <