1

open LustreSpec

2

open Corelang

3

open Log

4

open Format

5


6

let random_seed = ref 0

7

let threshold_delay = 95

8

let threshold_inc_int = 97

9

let threshold_dec_int = 97

10

let threshold_random_int = 96

11

let threshold_switch_int = 100 (* not implemented yet *)

12

let threshold_random_float = 100 (* not used yet *)

13

let threshold_negate_bool_var = 95

14

let threshold_arith_op = 95

15

let threshold_rel_op = 95

16

let threshold_bool_op = 95

17


18

let int_consts = ref []

19


20

let rename_app id =

21

if !Options.no_mutation_suffix then

22

id

23

else

24

id ^ "_mutant"

25


26

(************************************************************************************)

27

(* Gathering constants in the code *)

28

(************************************************************************************)

29


30

module IntSet = Set.Make (struct type t = int let compare = compare end)

31

module OpCount = Mmap.Make (struct type t = string let compare = compare end)

32


33

type records = {

34

consts: IntSet.t;

35

nb_boolexpr: int;

36

nb_pre: int;

37

nb_op: int OpCount.t;

38

}

39


40

let arith_op = ["+" ; "" ; "*" ; "/"]

41

let bool_op = ["&&"; ""; "xor"; "impl"]

42

let rel_op = ["<" ; "<=" ; ">" ; ">=" ; "!=" ; "=" ]

43

let ops = arith_op @ bool_op @ rel_op

44

let all_ops = "not" :: ops

45


46

let empty_records =

47

{consts=IntSet.empty; nb_boolexpr=0; nb_pre=0; nb_op=OpCount.empty}

48


49

let records = ref empty_records

50


51

let merge_records records_list =

52

let merge_record r1 r2 =

53

{

54

consts = IntSet.union r1.consts r2.consts;

55


56

nb_boolexpr = r1.nb_boolexpr + r2.nb_boolexpr;

57

nb_pre = r1.nb_pre + r2.nb_pre;

58


59

nb_op = OpCount.merge (fun op r1opt r2opt >

60

match r1opt, r2opt with

61

 None, _ > r2opt

62

 _, None > r1opt

63

 Some x, Some y > Some (x+y)

64

) r1.nb_op r2.nb_op

65

}

66

in

67

List.fold_left merge_record empty_records records_list

68


69

let compute_records_const_value c =

70

match c with

71

 Const_int i > {empty_records with consts = IntSet.singleton i}

72

 _ > empty_records

73


74

let rec compute_records_expr expr =

75

let boolexpr =

76

if (Types.repr expr.expr_type).Types.tdesc = Types.Tbool then

77

{empty_records with nb_boolexpr = 1}

78

else

79

empty_records

80

in

81

let subrec =

82

match expr.expr_desc with

83

 Expr_const c > compute_records_const_value c

84

 Expr_tuple l > merge_records (List.map compute_records_expr l)

85

 Expr_ite (i,t,e) >

86

merge_records (List.map compute_records_expr [i;t;e])

87

 Expr_arrow (e1, e2) >

88

merge_records (List.map compute_records_expr [e1;e2])

89

 Expr_pre e >

90

merge_records (

91

({empty_records with nb_pre = 1})

92

::[compute_records_expr e])

93

 Expr_appl (op_id, args, r) >

94

if List.mem op_id ops then

95

merge_records (

96

({empty_records with nb_op = OpCount.singleton op_id 1})

97

::[compute_records_expr args])

98

else

99

compute_records_expr args

100

 _ > empty_records

101

in

102

merge_records [boolexpr;subrec]

103


104

let compute_records_eq eq = compute_records_expr eq.eq_rhs

105


106

let compute_records_node nd =

107

merge_records (List.map compute_records_eq (get_node_eqs nd))

108


109

let compute_records_top_decl td =

110

match td.top_decl_desc with

111

 Node nd > compute_records_node nd

112

 Const cst > compute_records_const_value cst.const_value

113

 _ > empty_records

114


115

let compute_records prog =

116

merge_records (List.map compute_records_top_decl prog)

117


118

(*****************************************************************)

119

(* Random mutation *)

120

(*****************************************************************)

121


122

let check_mut e1 e2 =

123

let rec eq e1 e2 =

124

match e1.expr_desc, e2.expr_desc with

125

 Expr_const c1, Expr_const c2 > c1 = c2

126

 Expr_ident id1, Expr_ident id2 > id1 = id2

127

 Expr_tuple el1, Expr_tuple el2 > List.length el1 = List.length el2 && List.for_all2 eq el1 el2

128

 Expr_ite (i1, t1, e1), Expr_ite (i2, t2, e2) > eq i1 i2 && eq t1 t2 && eq e1 e2

129

 Expr_arrow (x1, y1), Expr_arrow (x2, y2) > eq x1 x2 && eq y1 y2

130

 Expr_pre e1, Expr_pre e2 > eq e1 e2

131

 Expr_appl (id1, e1, _), Expr_appl (id2, e2, _) > id1 = id2 && eq e1 e2

132

 _ > false

133

in

134

if not (eq e1 e2) then

135

Some (e1, e2)

136

else

137

None

138


139

let mk_cst_expr c = mkexpr Location.dummy_loc (Expr_const c)

140


141

let rdm_mutate_int i =

142

if Random.int 100 > threshold_inc_int then

143

i+1

144

else if Random.int 100 > threshold_dec_int then

145

i1

146

else if Random.int 100 > threshold_random_int then

147

Random.int 10

148

else if Random.int 100 > threshold_switch_int then

149

let idx = Random.int (List.length !int_consts) in

150

List.nth !int_consts idx

151

else

152

i

153


154

let rdm_mutate_real r =

155

if Random.int 100 > threshold_random_float then

156

(* interval [0, bound] for random values *)

157

let bound = 10 in

158

(* max number of digits after comma *)

159

let digits = 5 in

160

(* number of digits after comma *)

161

let shift = Random.int (digits + 1) in

162

let eshift = 10. ** (float_of_int shift) in

163

let i = Random.int (1 + bound * (int_of_float eshift)) in

164

let f = float_of_int i /. eshift in

165

(Num.num_of_int i, shift, string_of_float f)

166

else

167

r

168


169

let rdm_mutate_op op =

170

match op with

171

 "+"  ""  "*"  "/" when Random.int 100 > threshold_arith_op >

172

let filtered = List.filter (fun x > x <> op) ["+"; ""; "*"; "/"] in

173

List.nth filtered (Random.int 3)

174

 "&&"  ""  "xor"  "impl" when Random.int 100 > threshold_bool_op >

175

let filtered = List.filter (fun x > x <> op) ["&&"; ""; "xor"; "impl"] in

176

List.nth filtered (Random.int 3)

177

 "<"  "<="  ">"  ">="  "!="  "=" when Random.int 100 > threshold_rel_op >

178

let filtered = List.filter (fun x > x <> op) ["<"; "<="; ">"; ">="; "!="; "="] in

179

List.nth filtered (Random.int 5)

180

 _ > op

181


182


183

let rdm_mutate_var expr =

184

match (Types.repr expr.expr_type).Types.tdesc with

185

 Types.Tbool >

186

(* if Random.int 100 > threshold_negate_bool_var then *)

187

let new_e = mkpredef_call expr.expr_loc "not" [expr] in

188

Some (expr, new_e), new_e

189

(* else *)

190

(* expr *)

191

 _ > None, expr

192


193

let rdm_mutate_pre orig_expr =

194

let new_e = Expr_pre orig_expr in

195

Some (orig_expr, {orig_expr with expr_desc = new_e}), new_e

196


197


198

let rdm_mutate_const_value c =

199

match c with

200

 Const_int i > Const_int (rdm_mutate_int i)

201

 Const_real (n, i, s) > let (n', i', s') = rdm_mutate_real (n, i, s) in Const_real (n', i', s')

202

 Const_array _

203

 Const_string _

204

 Const_struct _

205

 Const_tag _ > c

206


207

let rdm_mutate_const c =

208

let new_const = rdm_mutate_const_value c.const_value in

209

let mut = check_mut (mk_cst_expr c.const_value) (mk_cst_expr new_const) in

210

mut, { c with const_value = new_const }

211


212


213

let select_in_list list rdm_mutate_elem =

214

let selected = Random.int (List.length list) in

215

let mutation_opt, new_list, _ =

216

List.fold_right

217

(fun elem (mutation_opt, res, cpt) > if cpt = selected then

218

let mutation, new_elem = rdm_mutate_elem elem in

219

Some mutation, new_elem::res, cpt+1 else mutation_opt, elem::res, cpt+1)

220

list

221

(None, [], 0)

222

in

223

match mutation_opt with

224

 Some mut > mut, new_list

225

 _ > assert false

226


227


228

let rec rdm_mutate_expr expr =

229

let mk_e d = { expr with expr_desc = d } in

230

match expr.expr_desc with

231

 Expr_ident id > rdm_mutate_var expr

232

 Expr_const c >

233

let new_const = rdm_mutate_const_value c in

234

let mut = check_mut (mk_cst_expr c) (mk_cst_expr new_const) in

235

mut, mk_e (Expr_const new_const)

236

 Expr_tuple l >

237

let mut, l' = select_in_list l rdm_mutate_expr in

238

mut, mk_e (Expr_tuple l')

239

 Expr_ite (i,t,e) > (

240

let mut, l = select_in_list [i; t; e] rdm_mutate_expr in

241

match l with

242

 [i'; t'; e'] > mut, mk_e (Expr_ite (i', t', e'))

243

 _ > assert false

244

)

245

 Expr_arrow (e1, e2) > (

246

let mut, l = select_in_list [e1; e2] rdm_mutate_expr in

247

match l with

248

 [e1'; e2'] > mut, mk_e (Expr_arrow (e1', e2'))

249

 _ > assert false

250

)

251

 Expr_pre e >

252

let select_pre = Random.bool () in

253

if select_pre then

254

let mut, new_expr = rdm_mutate_pre expr in

255

mut, mk_e new_expr

256

else

257

let mut, e' = rdm_mutate_expr e in

258

mut, mk_e (Expr_pre e')

259

 Expr_appl (op_id, args, r) >

260

let select_op = Random.bool () in

261

if select_op then

262

let new_op_id = rdm_mutate_op op_id in

263

let new_e = mk_e (Expr_appl (new_op_id, args, r)) in

264

let mut = check_mut expr new_e in

265

mut, new_e

266

else

267

let mut, new_args = rdm_mutate_expr args in

268

mut, mk_e (Expr_appl (op_id, new_args, r))

269

(* Other constructs are kept.

270

 Expr_fby of expr * expr

271

 Expr_array of expr list

272

 Expr_access of expr * Dimension.dim_expr

273

 Expr_power of expr * Dimension.dim_expr

274

 Expr_when of expr * ident * label

275

 Expr_merge of ident * (label * expr) list

276

 Expr_uclock of expr * int

277

 Expr_dclock of expr * int

278

 Expr_phclock of expr * rat *)

279

 _ > None, expr

280


281


282

let rdm_mutate_eq eq =

283

let mutation, new_rhs = rdm_mutate_expr eq.eq_rhs in

284

mutation, { eq with eq_rhs = new_rhs }

285


286

let rnd_mutate_stmt stmt =

287

match stmt with

288

 Eq eq > let mut, new_eq = rdm_mutate_eq eq in

289

report ~level:1

290

(fun fmt > fprintf fmt "mutation: %a becomes %a@."

291

Printers.pp_node_eq eq

292

Printers.pp_node_eq new_eq);

293

mut, Eq new_eq

294

 Aut aut > assert false

295


296

let rdm_mutate_node nd =

297

let mutation, new_node_stmts =

298

select_in_list

299

nd.node_stmts rnd_mutate_stmt

300

in

301

mutation, { nd with node_stmts = new_node_stmts }

302


303

let rdm_mutate_top_decl td =

304

match td.top_decl_desc with

305

 Node nd >

306

let mutation, new_node = rdm_mutate_node nd in

307

mutation, { td with top_decl_desc = Node new_node}

308

 Const cst >

309

let mut, new_cst = rdm_mutate_const cst in

310

mut, { td with top_decl_desc = Const new_cst }

311

 _ > None, td

312


313

(* Create a single mutant with the provided random seed *)

314

let rdm_mutate_prog prog =

315

select_in_list prog rdm_mutate_top_decl

316


317

let rdm_mutate nb prog =

318

let rec iterate nb res =

319

incr random_seed;

320

if nb <= 0 then

321

res

322

else (

323

Random.init !random_seed;

324

let mutation, new_mutant = rdm_mutate_prog prog in

325

match mutation with

326

None > iterate nb res

327

 Some mutation > (

328

if List.mem_assoc mutation res then (

329

iterate nb res

330

)

331

else (

332

report ~level:1 (fun fmt > fprintf fmt "%i mutants remaining@." nb);

333

iterate (nb1) ((mutation, new_mutant)::res)

334

)

335

)

336

)

337

in

338

iterate nb []

339


340


341

(*****************************************************************)

342

(* Random mutation *)

343

(*****************************************************************)

344


345

type mutant_t = Boolexpr of int  Pre of int  Op of string * int * string  IncrIntCst of int  DecrIntCst of int  SwitchIntCst of int * int

346


347

let target : mutant_t option ref = ref None

348


349

let print_directive fmt d =

350

match d with

351

 Pre n > Format.fprintf fmt "pre %i" n

352

 Boolexpr n > Format.fprintf fmt "boolexpr %i" n

353

 Op (o, i, d) > Format.fprintf fmt "%s %i > %s" o i d

354

 IncrIntCst n > Format.fprintf fmt "incr int cst %i" n

355

 DecrIntCst n > Format.fprintf fmt "decr int cst %i" n

356

 SwitchIntCst (n, m) > Format.fprintf fmt "switch int cst %i > %i" n m

357


358

let fold_mutate_int i =

359

if Random.int 100 > threshold_inc_int then

360

i+1

361

else if Random.int 100 > threshold_dec_int then

362

i1

363

else if Random.int 100 > threshold_random_int then

364

Random.int 10

365

else if Random.int 100 > threshold_switch_int then

366

try

367

let idx = Random.int (List.length !int_consts) in

368

List.nth !int_consts idx

369

with _ > i

370

else

371

i

372


373

let fold_mutate_float f =

374

if Random.int 100 > threshold_random_float then

375

Random.float 10.

376

else

377

f

378


379

let fold_mutate_op op =

380

(* match op with *)

381

(*  "+"  ""  "*"  "/" when Random.int 100 > threshold_arith_op > *)

382

(* let filtered = List.filter (fun x > x <> op) ["+"; ""; "*"; "/"] in *)

383

(* List.nth filtered (Random.int 3) *)

384

(*  "&&"  ""  "xor"  "impl" when Random.int 100 > threshold_bool_op > *)

385

(* let filtered = List.filter (fun x > x <> op) ["&&"; ""; "xor"; "impl"] in *)

386

(* List.nth filtered (Random.int 3) *)

387

(*  "<"  "<="  ">"  ">="  "!="  "=" when Random.int 100 > threshold_rel_op > *)

388

(* let filtered = List.filter (fun x > x <> op) ["<"; "<="; ">"; ">="; "!="; "="] in *)

389

(* List.nth filtered (Random.int 5) *)

390

(*  _ > op *)

391

match !target with

392

 Some (Op(op_orig, 0, op_new)) when op_orig = op > (

393

target := None;

394

op_new

395

)

396

 Some (Op(op_orig, n, op_new)) when op_orig = op > (

397

target := Some (Op(op_orig, n1, op_new));

398

op

399

)

400

 _ > if List.mem op Basic_library.internal_funs then op else rename_app op

401


402


403

let fold_mutate_var expr =

404

(* match (Types.repr expr.expr_type).Types.tdesc with *)

405

(*  Types.Tbool > *)

406

(* (\* if Random.int 100 > threshold_negate_bool_var then *\) *)

407

(* mkpredef_unary_call Location.dummy_loc "not" expr *)

408

(* (\* else *\) *)

409

(* (\* expr *\) *)

410

(*  _ >

411

*)expr

412


413

let fold_mutate_boolexpr expr =

414

match !target with

415

 Some (Boolexpr 0) > (

416

target := None;

417

mkpredef_call expr.expr_loc "not" [expr]

418

)

419

 Some (Boolexpr n) >

420

(target := Some (Boolexpr (n1)); expr)

421

 _ > expr

422


423

let fold_mutate_pre orig_expr e =

424

match !target with

425

Some (Pre 0) > (

426

target := None;

427

Expr_pre ({orig_expr with expr_desc = Expr_pre e})

428

)

429

 Some (Pre n) > (

430

target := Some (Pre (n1));

431

Expr_pre e

432

)

433

 _ > Expr_pre e

434


435

let fold_mutate_const_value c =

436

match c with

437

 Const_int i > (

438

match !target with

439

 Some (IncrIntCst 0) > (target := None; Const_int (i+1))

440

 Some (DecrIntCst 0) > (target := None; Const_int (i1))

441

 Some (SwitchIntCst (0, id)) > (target := None; Const_int (List.nth (IntSet.elements (IntSet.remove i !records.consts)) id))

442

 Some (IncrIntCst n) > (target := Some (IncrIntCst (n1)); c)

443

 Some (DecrIntCst n) > (target := Some (DecrIntCst (n1)); c)

444

 Some (SwitchIntCst (n, id)) > (target := Some (SwitchIntCst (n1, id)); c)

445

 _ > c)

446

 _ > c

447


448

(*

449

match c with

450

 Const_int i > Const_int (fold_mutate_int i)

451

 Const_real s > Const_real s (* those are string, let's leave them *)

452

 Const_float f > Const_float (fold_mutate_float f)

453

 Const_array _

454

 Const_tag _ > c

455

TODO

456


457

*)

458

let fold_mutate_const c =

459

{ c with const_value = fold_mutate_const_value c.const_value }

460


461

let rec fold_mutate_expr expr =

462

let new_expr =

463

match expr.expr_desc with

464

 Expr_ident id > fold_mutate_var expr

465

 _ > (

466

let new_desc = match expr.expr_desc with

467

 Expr_const c > Expr_const (fold_mutate_const_value c)

468

 Expr_tuple l > Expr_tuple (List.fold_right (fun e res > (fold_mutate_expr e)::res) l [])

469

 Expr_ite (i,t,e) > Expr_ite (fold_mutate_expr i, fold_mutate_expr t, fold_mutate_expr e)

470

 Expr_arrow (e1, e2) > Expr_arrow (fold_mutate_expr e1, fold_mutate_expr e2)

471

 Expr_pre e > fold_mutate_pre expr (fold_mutate_expr e)

472

 Expr_appl (op_id, args, r) > Expr_appl (fold_mutate_op op_id, fold_mutate_expr args, r)

473

(* Other constructs are kept.

474

 Expr_fby of expr * expr

475

 Expr_array of expr list

476

 Expr_access of expr * Dimension.dim_expr

477

 Expr_power of expr * Dimension.dim_expr

478

 Expr_when of expr * ident * label

479

 Expr_merge of ident * (label * expr) list

480

 Expr_uclock of expr * int

481

 Expr_dclock of expr * int

482

 Expr_phclock of expr * rat *)

483

 _ > expr.expr_desc

484


485

in

486

{ expr with expr_desc = new_desc }

487

)

488

in

489

if (Types.repr expr.expr_type).Types.tdesc = Types.Tbool then

490

fold_mutate_boolexpr new_expr

491

else

492

new_expr

493


494

let fold_mutate_eq eq =

495

{ eq with eq_rhs = fold_mutate_expr eq.eq_rhs }

496


497

let fold_mutate_stmt stmt =

498

match stmt with

499

 Eq eq > Eq (fold_mutate_eq eq)

500

 Aut aut > assert false

501


502

let fold_mutate_node nd =

503

{ nd with

504

node_stmts =

505

List.fold_right (fun stmt res > (fold_mutate_stmt stmt)::res) nd.node_stmts [];

506

node_id = rename_app nd.node_id

507

}

508


509

let fold_mutate_top_decl td =

510

match td.top_decl_desc with

511

 Node nd > { td with top_decl_desc = Node (fold_mutate_node nd)}

512

 Const cst > { td with top_decl_desc = Const (fold_mutate_const cst)}

513

 _ > td

514


515

(* Create a single mutant with the provided random seed *)

516

let fold_mutate_prog prog =

517

List.fold_right (fun e res > (fold_mutate_top_decl e)::res) prog []

518


519

let create_mutant prog directive =

520

target := Some directive;

521

let prog' = fold_mutate_prog prog in

522

target := None;

523

prog'

524


525


526

let op_mutation op =

527

let res =

528

let rem_op l = List.filter (fun e > e <> op) l in

529

if List.mem op arith_op then rem_op arith_op else

530

if List.mem op bool_op then rem_op bool_op else

531

if List.mem op rel_op then rem_op rel_op else

532

(Format.eprintf "Failing with op %s@." op;

533

assert false

534

)

535

in

536

(* Format.eprintf "Mutation op %s to [%a]@." op (Utils.fprintf_list ~sep:"," Format.pp_print_string) res; *)

537

res

538


539

let rec remains select list =

540

match list with

541

[] > []

542

 hd::tl > if select hd then tl else remains select tl

543


544

let next_change m =

545

let res =

546

let rec first_op () =

547

try

548

let min_binding = OpCount.min_binding !records.nb_op in

549

Op (fst min_binding, 0, List.hd (op_mutation (fst min_binding)))

550

with Not_found > first_boolexpr ()

551

and first_boolexpr () =

552

if !records.nb_boolexpr > 0 then

553

Boolexpr 0

554

else first_pre ()

555

and first_pre () =

556

if !records.nb_pre > 0 then

557

Pre 0

558

else

559

first_op ()

560

and first_intcst () =

561

if IntSet.cardinal !records.consts > 0 then

562

IncrIntCst 0

563

else

564

first_boolexpr ()

565

in

566

match m with

567

 Boolexpr n >

568

if n+1 >= !records.nb_boolexpr then

569

first_pre ()

570

else

571

Boolexpr (n+1)

572

 Pre n >

573

if n+1 >= !records.nb_pre then

574

first_op ()

575

else Pre (n+1)

576

 Op (orig, id, mut_op) > (

577

match remains (fun x > x = mut_op) (op_mutation orig) with

578

 next_op::_ > Op (orig, id, next_op)

579

 [] > if id+1 >= OpCount.find orig !records.nb_op then (

580

match remains (fun (k1, _) > k1 = orig) (OpCount.bindings !records.nb_op) with

581

 [] > first_intcst ()

582

 hd::_ > Op (fst hd, 0, List.hd (op_mutation (fst hd)))

583

) else

584

Op(orig, id+1, List.hd (op_mutation orig))

585

)

586

 IncrIntCst n >

587

if n+1 >= IntSet.cardinal !records.consts then

588

DecrIntCst 0

589

else IncrIntCst (n+1)

590

 DecrIntCst n >

591

if n+1 >= IntSet.cardinal !records.consts then

592

SwitchIntCst (0, 0)

593

else DecrIntCst (n+1)

594

 SwitchIntCst (n, m) >

595

if m+1 > 1 + IntSet.cardinal !records.consts then

596

SwitchIntCst (n, m+1)

597

else if n+1 >= IntSet.cardinal !records.consts then

598

SwitchIntCst (n+1, 0)

599

else first_boolexpr ()

600


601

in

602

(* Format.eprintf "from: %a to: %a@." print_directive m print_directive res; *)

603

res

604


605

let fold_mutate nb prog =

606

incr random_seed;

607

Random.init !random_seed;

608

let find_next_new mutants mutant =

609

let rec find_next_new init current =

610

if init = current then raise Not_found else

611

if List.mem current mutants then

612

find_next_new init (next_change current)

613

else

614

current

615

in

616

find_next_new mutant (next_change mutant)

617

in

618

(* Creating list of nb elements of mutants *)

619

let rec create_mutants_directives rnb mutants =

620

if rnb <= 0 then mutants

621

else

622

let random_mutation =

623

match Random.int 6 with

624

 5 > IncrIntCst (try Random.int (IntSet.cardinal !records.consts) with _ > 0)

625

 4 > DecrIntCst (try Random.int (IntSet.cardinal !records.consts) with _ > 0)

626

 3 > SwitchIntCst ((try Random.int (IntSet.cardinal !records.consts) with _ > 0), (try Random.int (1 + IntSet.cardinal !records.consts) with _ > 0))

627

 2 > Pre (try Random.int !records.nb_pre with _ > 0)

628

 1 > Boolexpr (try Random.int !records.nb_boolexpr with _ > 0)

629

 0 > let bindings = OpCount.bindings !records.nb_op in

630

let op, nb_op = List.nth bindings (try Random.int (List.length bindings) with _ > 0) in

631

let new_op = List.nth (op_mutation op) (try Random.int (List.length (op_mutation op)) with _ > 0) in

632

Op (op, (try Random.int nb_op with _ > 0), new_op)

633

 _ > assert false

634

in

635

if List.mem random_mutation mutants then

636

try

637

let new_mutant = (find_next_new mutants random_mutation) in

638

report ~level:2 (fun fmt > fprintf fmt " %i mutants generated out of %i expected@." (nbrnb) nb);

639

create_mutants_directives (rnb1) (new_mutant::mutants)

640

with Not_found > (

641

report ~level:1 (fun fmt > fprintf fmt "Only %i mutants generated out of %i expected@." (nbrnb) nb);

642

mutants

643

)

644

else

645

create_mutants_directives (rnb1) (random_mutation::mutants)

646

in

647

let mutants_directives = create_mutants_directives nb [] in

648

List.map (fun d > d, create_mutant prog d) mutants_directives

649


650


651

let mutate nb prog =

652

records := compute_records prog;

653

(* Format.printf "Records: %i pre, %i boolexpr" (\* , %a ops *\) *)

654

(* !records.nb_pre *)

655

(* !records.nb_boolexpr *)

656

(* (\* !records.op *\) *)

657

(* ; *)

658

fold_mutate nb prog, print_directive

659


660


661


662


663

(* Local Variables: *)

664

(* compilecommand:"make C .." *)

665

(* End: *)

666


667

