Skip to content

Commit c083bf2

Browse files
jmidjmid
authored
Merge pull request #30 from jmid/fix-poly-equal
Fix incompatibility with Core
2 parents 7407445 + 9f6f5fd commit c083bf2

File tree

19 files changed

+555
-219
lines changed

19 files changed

+555
-219
lines changed

‎CHANGES.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@ Next version
22
------------
33

44
- Avoid mutations in attribute parameters #29
5+
- Avoid polymorphic equality which is incompatible with Core #30
56

67
0.2
78
---

‎src/ppx/mutaml_ppx.ml‎

Lines changed: 15 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ module Vb = Ppxlib.Ast_helper.Vb
1414
into a test
1515
1616
[%expr
17-
if __MUTAML_MUTANT__ = Some "src/lib:42"
17+
if __is_mutaml_mutant__ "src/lib:42"
1818
then e
1919
else e+1]
2020
@@ -30,15 +30,16 @@ module Vb = Ppxlib.Ast_helper.Vb
3030
- a generation-time counter (42)
3131
- a reserved OCaml variable __MUTAML_MUTANT__, containing the value of
3232
- an environment variable MUTAML_MUTANT
33+
- a predicate __is_mutaml_mutant
3334
- a store of mutations for each instrumented file
3435
*)
3536

3637
(** Returns a new structure with an added mutaml preamble *)
3738
let add_preamble structure input_name =
3839
let loc = Location.in_file input_name in
39-
let preamble =
40-
[%stri let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT"] in
41-
preamble::structure
40+
[%stri let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT"]::
41+
[%stri let __is_mutaml_mutant__ m = match __MUTAML_MUTANT__ with None -> false | Some mutant -> String.equal m mutant]::
42+
structure
4243

4344
(** Write mutations of a file 'src/lib.ml' to a 'src/lib.muts' *)
4445
let write_muts_file input_name mutations =
@@ -236,7 +237,7 @@ class mutate_mapper (rs : RS.t) =
236237
let mutation = Mutaml_common.{ number = mut_no; repl = Some repl_str; loc } in
237238
mutations <- mutation::mutations;
238239
[%expr
239-
if __MUTAML_MUTANT__ = Some [%e mut_id_exp]
240+
if __is_mutaml_mutant__ [%e mut_id_exp]
240241
then [%e e_new]
241242
else [%e e_rec]]
242243

@@ -261,7 +262,7 @@ class mutate_mapper (rs : RS.t) =
261262
solution: let-name locally:
262263
let __mutaml_tmp25 = exp2 in
263264
let __mutaml_tmp26 = exp1 in
264-
if __MUTAML_MUTANT__ = Some 17
265+
if __is_mutaml_mutant__ 17
265266
then __mutaml_tmp26 - __mutaml_tmp25
266267
else __mutaml_tmp26 + __mutaml_tmp25 *)
267268
match e with
@@ -336,7 +337,7 @@ class mutate_mapper (rs : RS.t) =
336337
let loc = { case1.pc_lhs.ppat_loc with (* location of entire case: lhs with guard -> rhs *)
337338
loc_end = case1.pc_rhs.pexp_loc.loc_end } in
338339
let mut_no,mut_id_exp = self#make_mut_number_and_id loc ctx in
339-
let mut_guard = [%expr __MUTAML_MUTANT__ <> Some [%e mut_id_exp] ] in
340+
let mut_guard = [%expr not (__is_mutaml_mutant__ [%e mut_id_exp]) ] in
340341
let guard = (match case1.pc_guard with
341342
| None -> Some mut_guard
342343
| Some g -> Some [%expr [%e g] && [%e mut_guard] ]) in
@@ -346,12 +347,12 @@ class mutate_mapper (rs : RS.t) =
346347
then
347348
(* drop case from pattern-match when there is a '_'-catch all case and >1 additional cases *)
348349
(* match f x with match f x with
349-
| A -> g y | A when __MUTAML_MUTANT__ <> (Some "test:27") -> g y
350-
| B -> h z ~~> | B when __MUTAML_MUTANT__ <> (Some "test:45") -> h z
350+
| A -> g y | A when not (__is_mutaml_mutant__ "test:27") -> g y
351+
| B -> h z ~~> | B when not (__is_mutaml_mutant__ "test:45") -> h z
351352
| _ -> i q | _ -> i q *)
352353
(* or if there is pattern containing a 'when'-clause to drop *)
353354
(* match f x with match f x with
354-
| B when c -> h z ~~> | B when c &&__MUTAML_MUTANT__ <> (Some "test:45") -> h z
355+
| B when c -> h z ~~> | B when c && not (__is_mutaml_mutant__ "test:45") -> h z
355356
| B -> i q | B -> i q *)
356357
let mutation = Mutaml_common.{ number = mut_no; repl = None;
357358
loc = { loc with loc_end = case2.pc_lhs.ppat_loc.loc_start }} in
@@ -365,8 +366,8 @@ class mutate_mapper (rs : RS.t) =
365366
(* merge consecutive cases into an or-pattern | p1 -> r1 | p2 -> r2 ~~> |p1|p2 -> r2 *)
366367
(* when no/same variables are bound in each pattern *)
367368
(* match f x with match f x with
368-
| A -> g y | A when __MUTAML_MUTANT__ <> (Some "test:27") -> g y
369-
| B -> h z ~~> | A | B when __MUTAML_MUTANT__ <> (Some "test:45") -> h z
369+
| A -> g y | A when not (__is_mutaml_mutant__ "test:27") -> g y
370+
| B -> h z ~~> | A | B when not (__is_mutaml_mutant__ "test:45") -> h z
370371
| C -> i q | B | C -> i q *)
371372
(match cases' with (* recurse and glue or-pattern on case2' *)
372373
| [] -> failwith "mutaml_ppx, mutate_pure_cases: recursing on a non-empty list yielded back an empty one"
@@ -430,7 +431,7 @@ class mutate_mapper (rs : RS.t) =
430431
* it works for 1-armed ifs too
431432
if
432433
(let __MUTAML_TMP__ = e0 in
433-
if e0 then e1 else e2 ~~> if __MUTAML_MUTANT__ = Some [%e mut_id_exp]
434+
if e0 then e1 else e2 ~~> if __is_mutaml_mutant__ [%e mut_id_exp]
434435
then not __MUTAML_TMP__ else __MUTAML_TMP__)
435436
then e1
436437
else e2 *)
@@ -452,7 +453,7 @@ class mutate_mapper (rs : RS.t) =
452453

453454
(* omit a unit-expression in a sequence:
454455
455-
(if __MUTAML_MUTANT__ = Some [%e mut_id_exp]
456+
(if __is_mutaml_mutant__ [%e mut_id_exp]
456457
e0; e1 ~~> then ()
457458
else e0'); e' *)
458459
| _, Pexp_sequence (e0,e1) when self#choose_to_mutate ->

‎test/instrumentation-tests/arith.t‎

Lines changed: 45 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,11 @@ Test + 1:
2121
Writing mutation info to test.muts
2222

2323
let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT"
24-
let f x = if __MUTAML_MUTANT__ = (Some "test:0") then x else x + 1
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
2529
;;assert ((f 5) = 6)
2630

2731
Check that instrumentation hasn't changed the program's behaviour
@@ -48,7 +52,11 @@ Test - 1:
4852
Writing mutation info to test.muts
4953

5054
let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT"
51-
let f x = if __MUTAML_MUTANT__ = (Some "test:0") then x else x - 1
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
5260
;;assert ((f 5) = 4)
5361

5462
$ dune exec --no-build ./test.bc
@@ -73,7 +81,11 @@ z
7381
Writing mutation info to test.muts
7482

7583
let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT"
76-
let f x = if __MUTAML_MUTANT__ = (Some "test:0") then x else 1 + x
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
7789
;;assert ((f 5) = 6)
7890

7991
$ dune exec --no-build ./test.bc
@@ -98,7 +110,11 @@ Test addition:
98110
Writing mutation info to test.muts
99111

100112
let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT"
101-
let f x y = if __MUTAML_MUTANT__ = (Some "test:0") then x - y else x + y
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
102118
;;assert ((f 5 6) = 11)
103119

104120
$ dune exec --no-build ./test.bc
@@ -123,7 +139,11 @@ Test subtraction mutation:
123139
Writing mutation info to test.muts
124140

125141
let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT"
126-
let f x y = if __MUTAML_MUTANT__ = (Some "test:0") then x + y else x - y
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
127147
;;assert ((f 6 5) = 1)
128148

129149
$ dune exec --no-build ./test.bc
@@ -148,7 +168,11 @@ Test multiplication mutation:
148168
Writing mutation info to test.muts
149169

150170
let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT"
151-
let f x y = if __MUTAML_MUTANT__ = (Some "test:0") then x + y else x * y
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
152176
;;assert ((f 6 5) = 30)
153177

154178
$ dune exec --no-build ./test.bc
@@ -169,7 +193,11 @@ Test division mutation:
169193
Writing mutation info to test.muts
170194

171195
let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT"
172-
let f x y = if __MUTAML_MUTANT__ = (Some "test:0") then x mod y else x / y
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
173201
;;assert ((f 56 5) = 11)
174202

175203
$ dune exec --no-build ./test.bc
@@ -194,7 +222,11 @@ Test modulo mutation:
194222
Writing mutation info to test.muts
195223

196224
let __MUTAML_MUTANT__ = Stdlib.Sys.getenv_opt "MUTAML_MUTANT"
197-
let f x y = if __MUTAML_MUTANT__ = (Some "test:0") then x / y else x mod y
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
198230
;;assert ((f 56 6) = 2)
199231

200232
$ dune exec --no-build ./test.bc
@@ -239,10 +271,14 @@ we should use it instead.
239271
Writing mutation info to test.muts
240272

241273
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
242278
let f x y =
243279
let __MUTAML_TMP0__ = let () = print_endline "right" in y in
244280
let __MUTAML_TMP1__ = let () = print_endline "left" in x in
245-
if __MUTAML_MUTANT__ = (Some "test:0")
281+
if __is_mutaml_mutant__ "test:0"
246282
then __MUTAML_TMP1__ - __MUTAML_TMP0__
247283
else __MUTAML_TMP1__ + __MUTAML_TMP0__
248284
;;assert ((f 5 6) = 11)

‎test/instrumentation-tests/assert.t‎

Lines changed: 20 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -57,9 +57,13 @@ Set seed and (full) mutation rate as environment variables, for repeatability
5757
Writing mutation info to test.muts
5858

5959
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
6064
let foo =
6165
match Sys.word_size with
62-
| 32 -> if __MUTAML_MUTANT__ = (Some "test:0") then 33 else 32
66+
| 32 -> if __is_mutaml_mutant__ "test:0" then 33 else 32
6367
| _ -> assert false
6468

6569

@@ -81,12 +85,16 @@ Make an .ml-file:
8185
Writing mutation info to test.muts
8286

8387
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
8492
let foo =
8593
match Sys.word_size with
86-
| 32 -> if __MUTAML_MUTANT__ = (Some "test:0") then 33 else 32
94+
| 32 -> if __is_mutaml_mutant__ "test:0" then 33 else 32
8795
| _ ->
88-
(if __MUTAML_MUTANT__ = (Some "test:2") then () else assert (1 > 0);
89-
if __MUTAML_MUTANT__ = (Some "test:1") then 1 else 0)
96+
(if __is_mutaml_mutant__ "test:2" then () else assert (1 > 0);
97+
if __is_mutaml_mutant__ "test:1" then 1 else 0)
9098

9199

92100
$ MUTAML_MUTANT="test:0" dune exec --no-build -- ./test.bc
@@ -116,17 +124,20 @@ Make an .ml-file:
116124
Writing mutation info to test.muts
117125

118126
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
119131
let () =
120132
let tmp =
121-
(if __MUTAML_MUTANT__ = (Some "test:0") then false else true) =
122-
(not (if __MUTAML_MUTANT__ = (Some "test:1") then true else false)) in
133+
(if __is_mutaml_mutant__ "test:0" then false else true) =
134+
(not (if __is_mutaml_mutant__ "test:1" then true else false)) in
123135
assert tmp
124136
let () =
125137
let tmp =
126-
(String.length (if __MUTAML_MUTANT__ = (Some "test:2") then "" else " "))
127-
=
138+
(String.length (if __is_mutaml_mutant__ "test:2" then "" else " ")) =
128139
(let __MUTAML_TMP0__ = String.length "" in
129-
if __MUTAML_MUTANT__ = (Some "test:3")
140+
if __is_mutaml_mutant__ "test:3"
130141
then __MUTAML_TMP0__
131142
else 1 + __MUTAML_TMP0__) in
132143
assert tmp

‎test/instrumentation-tests/attributes.t‎

Lines changed: 34 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -35,14 +35,17 @@ Set seed and (full) mutation rate as environment variables, for repeatability
3535

3636
Preprocess, check for attribute and error
3737
$ 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 9 output.txt
38+
$ head -n 4 output.txt && echo "ERROR MESSAGE" && tail -n 12 output.txt
3939
Running mutaml instrumentation on "test.ml"
4040
Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true
4141
Created 0 mutations of test.ml
4242
Writing mutation info to test.muts
4343
ERROR MESSAGE
44-
4544
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
4649
let greet () = print_endline ("Hello," ^ " world!")[@@ppwarning
4750
"Stop using hello world!"]
4851
let () = greet ()
@@ -70,6 +73,10 @@ Preprocess, check that attribute no longer triggers an error
7073
$ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml
7174

7275
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
7380
let greet () = print_endline ("Hello," ^ " world!")[@@ppwarning
7481
"Stop using hello world!"]
7582
let () = greet ()
@@ -102,13 +109,17 @@ Create a test.ml file with a module attribute
102109
Preprocess, check that attribute triggers deprecation error
103110

104111
$ bash ../filter_dune_build.sh ./test.bc --instrument-with mutaml 2>&1 > output.txt
105-
$ head -n 4 output.txt && echo "ERROR MESSAGE" && tail -n 10 output.txt
112+
$ head -n 4 output.txt && echo "ERROR MESSAGE" && tail -n 14 output.txt
106113
Running mutaml instrumentation on "test.ml"
107114
Randomness seed: 896745231 Mutation rate: 100 GADTs enabled: true
108115
Created 0 mutations of test.ml
109116
Writing mutation info to test.muts
110117
ERROR MESSAGE
111118
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
112123
module T :
113124
sig val greet : unit -> unit[@@deprecated "Please stop using that example"]
114125
end = struct let greet () = print_endline ("Hello," ^ " world!") end
@@ -149,6 +160,10 @@ Preprocess, check for attribute and error
149160
Writing mutation info to test.muts
150161

151162
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
152167
let v = ((())[@testattr "unit attr"])
153168

154169

@@ -169,12 +184,16 @@ Preprocess, check for attribute and error
169184
Writing mutation info to test.muts
170185

171186
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
172191
let t =
173-
if __MUTAML_MUTANT__ = (Some "test:0")
192+
if __is_mutaml_mutant__ "test:0"
174193
then ((false)[@testattr "true attr"])
175194
else ((true)[@testattr "true attr"])
176195
let f =
177-
if __MUTAML_MUTANT__ = (Some "test:1")
196+
if __is_mutaml_mutant__ "test:1"
178197
then ((true)[@testattr "false attr"])
179198
else ((false)[@testattr "false attr"])
180199

@@ -195,8 +214,12 @@ Preprocess, check for attribute and error
195214
Writing mutation info to test.muts
196215

197216
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
198221
let str =
199-
if __MUTAML_MUTANT__ = (Some "test:0")
222+
if __is_mutaml_mutant__ "test:0"
200223
then (("")[@testattr "str attr"])
201224
else ((" ")[@testattr "str attr"])
202225

@@ -217,8 +240,12 @@ Preprocess, check for attribute and error
217240
Writing mutation info to test.muts
218241

219242
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
220247
let f x =
221-
if __MUTAML_MUTANT__ = (Some "test:0")
248+
if __is_mutaml_mutant__ "test:0"
222249
then ((x)[@testattr "str attr"])
223250
else ((x + 1)[@testattr "str attr"])
224251

0 commit comments

Comments
 (0)