Project

General

Profile

Revision bde99c3f

View differences:

configure.ac
7 7
#AC_SUBST(VERSION_CODENAME, "Xia/Shao Kang")
8 8

  
9 9
AC_CONFIG_SRCDIR([src/main_lustre_compiler.ml])
10
AC_CONFIG_SRCDIR([src/main_lustre_testgen.ml])
10 11

  
11 12
# default prefix is /usr/local
12 13
AC_PREFIX_DEFAULT(/usr/local)
src/_tags
7 7
"main_lustre_compiler.native": use_str
8 8
"main_lustre_compiler.native": use_unix
9 9
"main_lustre_compiler.native": use_nums
10
"main_lustre_testgen.native": package(ocamlgraph)
11
"main_lustre_testgen.native": use_str
12
"main_lustre_testgen.native": use_unix
13
"main_lustre_testgen.native": use_nums
10 14
<*.ml{,i}>: package(ocamlgraph)
11 15
<*.ml{,i}>: use_str
12 16
<*.ml{,i}>: use_unix
src/backends/Horn/horn_backend.ml
52 52
let load_file f =
53 53
  let ic = open_in f in
54 54
  let n = in_channel_length ic in
55
  let s = String.create n in
55
  let s = Bytes.create n in
56 56
  really_input ic s 0 n;
57 57
  close_in ic;
58 58
  (s)
src/main_lustre_testgen.ml
59 59
  (* Creating destination directory if needed *)
60 60
  create_dest_dir ();
61 61

  
62
  (* Compatibility with Lusi *)
63
  (* Checking the existence of a lusi (Lustre Interface file) *)
64
  let extension = ".lusi" in
65
  compile_source_to_header prog computed_types_env computed_clocks_env dirname basename extension;
66

  
67 62
  Typing.uneval_prog_generics prog;
68 63
  Clock_calculus.uneval_prog_generics prog;
69 64

  
src/mutation.ml
1
open LustreSpec
1 2
open Corelang
2 3
open Log
3 4
open Format
......
103 104
let compute_records_eq eq = compute_records_expr eq.eq_rhs
104 105

  
105 106
let compute_records_node nd = 
106
  merge_records (List.map compute_records_eq nd.node_eqs)
107
  merge_records (List.map compute_records_eq (get_node_eqs nd))
107 108

  
108 109
let compute_records_top_decl td =
109 110
  match td.top_decl_desc with
110 111
  | Node nd -> compute_records_node nd
111
  | Consts constsl -> merge_records (List.map (fun c -> compute_records_const_value c.const_value) constsl)
112
  | Const cst -> compute_records_const_value cst.const_value
112 113
  | _ -> empty_records
113 114

  
114 115
let compute_records prog = 
......
150 151
  else
151 152
    i
152 153
  
153
let rdm_mutate_float f =
154
let rdm_mutate_real r =
154 155
  if Random.int 100 > threshold_random_float then
155
    Random.float 10.
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)
156 166
  else 
157
    f
167
    r
158 168

  
159 169
let rdm_mutate_op op = 
160 170
match op with
......
174 184
  match (Types.repr expr.expr_type).Types.tdesc with 
175 185
  | Types.Tbool ->
176 186
    (* if Random.int 100 > threshold_negate_bool_var then *)
177
    let new_e = mkpredef_unary_call Location.dummy_loc "not" expr in
187
    let new_e = mkpredef_call expr.expr_loc "not" [expr] in
178 188
    Some (expr, new_e), new_e
179 189
    (* else  *)
180 190
    (*   expr *)
......
188 198
let rdm_mutate_const_value c =
189 199
  match c with
190 200
  | Const_int i -> Const_int (rdm_mutate_int i)
191
  | Const_real s ->  Const_real s (* those are string, let's leave them *)
192
  | Const_float f -> Const_float (rdm_mutate_float f)
201
  | Const_real (n, i, s) -> let (n', i', s') = rdm_mutate_real (n, i, s) in Const_real (n', i', s')
193 202
  | Const_array _
203
  | Const_string _
204
  | Const_struct _
194 205
  | Const_tag _ -> c
195 206

  
196 207
let rdm_mutate_const c =
......
249 260
    else
250 261
      let mut, new_args = rdm_mutate_expr args in
251 262
      mut, mk_e (Expr_appl (op_id, new_args, r))
252
	
253 263
  (* Other constructs are kept.
254 264
  | Expr_fby of expr * expr
255 265
  | Expr_array of expr list
......
260 270
  | Expr_uclock of expr * int
261 271
  | Expr_dclock of expr * int
262 272
  | Expr_phclock of expr * rat *)
263
  (* | _ -> expr.expr_desc *)
273
   | _ -> None, expr
264 274
  
265 275

  
266 276
let rdm_mutate_eq eq =
267 277
  let mutation, new_rhs = rdm_mutate_expr eq.eq_rhs in
268 278
  mutation, { eq with eq_rhs = new_rhs }
269 279

  
270
let rdm_mutate_node nd = 
271
  let mutation, new_node_eqs =       
272
    select_in_list 
273
      nd.node_eqs 
274
      (fun eq -> let mut, new_eq = rdm_mutate_eq eq in
280
let rnd_mutate_stmt stmt =
281
  match stmt with
282
  | Eq eq   -> let mut, new_eq = rdm_mutate_eq eq in
275 283
		 report ~level:1 
276 284
		   (fun fmt -> fprintf fmt "mutation: %a becomes %a@." 
277 285
		     Printers.pp_node_eq eq
278 286
		     Printers.pp_node_eq new_eq);
279
		 mut, new_eq )
287
		 mut, Eq new_eq 
288
  | Aut aut -> assert false
289

  
290
let rdm_mutate_node nd = 
291
  let mutation, new_node_stmts =       
292
    select_in_list 
293
      nd.node_stmts rnd_mutate_stmt
280 294
  in
281
  mutation, { nd with node_eqs = new_node_eqs }
295
  mutation, { nd with node_stmts = new_node_stmts }
282 296

  
283 297
let rdm_mutate_top_decl td =
284 298
  match td.top_decl_desc with
285 299
  | Node nd -> 
286 300
    let mutation, new_node = rdm_mutate_node nd in 
287 301
    mutation, { td with top_decl_desc = Node new_node}
288
  | Consts constsl -> 
289
    let mut, new_constsl = select_in_list constsl rdm_mutate_const in
290
    mut, { td with top_decl_desc = Consts new_constsl }
302
  | Const cst -> 
303
    let mut, new_cst = rdm_mutate_const cst in
304
    mut, { td with top_decl_desc = Const new_cst }
291 305
  | _ -> None, td
292 306
    
293 307
(* Create a single mutant with the provided random seed *)
......
394 408
  match !target with
395 409
  | Some (Boolexpr 0) -> (
396 410
    target := None;
397
    mkpredef_unary_call Location.dummy_loc "not" expr
411
    mkpredef_call expr.expr_loc "not" [expr]
398 412
  )
399 413
  | Some (Boolexpr n) ->
400 414
      (target := Some (Boolexpr (n-1)); expr)
......
474 488
let fold_mutate_eq eq =
475 489
  { eq with eq_rhs = fold_mutate_expr eq.eq_rhs }
476 490

  
491
let fold_mutate_stmt stmt =
492
  match stmt with
493
  | Eq eq   -> Eq (fold_mutate_eq eq)
494
  | Aut aut -> assert false
495

  
477 496
let fold_mutate_node nd = 
478 497
  { nd with 
479
    node_eqs = 
480
      List.fold_right (fun e res -> (fold_mutate_eq e)::res) nd.node_eqs [];
498
    node_stmts = 
499
      List.fold_right (fun stmt res -> (fold_mutate_stmt stmt)::res) nd.node_stmts [];
481 500
    node_id = rename_app nd.node_id
482 501
  }
483 502

  
484 503
let fold_mutate_top_decl td =
485 504
  match td.top_decl_desc with
486
  | Node nd -> { td with top_decl_desc = Node (fold_mutate_node nd)}
487
  | Consts constsl -> { td with top_decl_desc = Consts (List.fold_right (fun e res -> (fold_mutate_const e)::res) constsl [])}
505
  | Node nd   -> { td with top_decl_desc = Node  (fold_mutate_node nd)}
506
  | Const cst -> { td with top_decl_desc = Const (fold_mutate_const cst)}
488 507
  | _ -> td
489 508
    
490 509
(* Create a single mutant with the provided random seed *)
src/pathConditions.ml
79 79
      (compute_neg_expr (cpt_pre+1) e)
80 80

  
81 81
  | Expr_appl (op_name, args, r) when List.mem op_name rel_op -> 
82
    [(expr, cpt_pre), mkpredef_unary_call Location.dummy_loc "not" expr]
82
    [(expr, cpt_pre), mkpredef_call expr.expr_loc "not" [expr]]
83 83

  
84 84
  | Expr_appl (op_name, args, r) -> 
85 85
    List.map 
......
87 87
	(compute_neg_expr cpt_pre args)
88 88

  
89 89
  | Expr_ident _ when (Types.repr expr.expr_type).Types.tdesc = Types.Tbool ->
90
    [(expr, cpt_pre), mkpredef_unary_call Location.dummy_loc "not" expr]
90
    [(expr, cpt_pre), mkpredef_call expr.expr_loc "not" [expr]]
91 91
  | _ -> []
92 92

  
93 93
and  
......
133 133
  | _::_, Types.Ttuple tl, Expr_tuple rhs -> List.iter2 mcdc_var_def eq.eq_lhs rhs
134 134
  | _ -> mcdc_expr 0 eq.eq_rhs 
135 135

  
136
let mcdc_node_stmt stmt =
137
  match stmt with
138
  | Eq eq -> mcdc_node_eq eq
139
  | Aut aut -> assert false
140

  
136 141
let mcdc_top_decl td = 
137 142
  match td.top_decl_desc with
138
  | Node nd -> List.iter mcdc_node_eq nd.node_eqs
143
  | Node nd -> List.iter mcdc_node_stmt nd.node_stmts
139 144
  | _ -> ()
140 145

  
141 146

  

Also available in: Unified diff