← Back to branch summary

~ubuntu-branches/ubuntu/karmic/coccinelle/karmic

« back to all changes in this revision

Viewing changes to engine/transformation_c.ml

  • Committer: Bazaar Package Importer
  • Author(s): Євгеній Мещеряков
  • Date: 2009-05-11 15:32:24 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090511153224-1odv41d4dkr3y80v
Tags: 0.1.8.deb-2
Use common install Makefile target for both native and bytecode
build. This hopefully fixes FTBFS on bytecode archs 

Show diffs side-by-side

added added

removed removed

Lines of Context:
engine/transformation_c.ml
34
34
  optional_qualifier_iso : bool;
35
35
  value_format_iso : bool;
36
36
  current_rule_name : string; (* used for errors *)
 
37
  index : int list (* witness tree indices *)
37
38
}
38
39
 
39
40
module XTRANS = struct
164
165
   let check_pos info mck pos = 
165
166
     match mck with
166
167
     | Ast_cocci.PLUS -> raise Impossible
167
 
     | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_) 
168
 
     | Ast_cocci.MINUS   (Ast_cocci.FixPos (i1,i2),_) -> 
 
168
     | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_)
 
169
     | Ast_cocci.MINUS   (Ast_cocci.FixPos (i1,i2),_,_,_) -> 
169
170
         pos <= i2 && pos >= i1
170
 
     | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_) 
171
 
     | Ast_cocci.MINUS   (Ast_cocci.DontCarePos,_) -> 
 
171
     | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_)
 
172
     | Ast_cocci.MINUS   (Ast_cocci.DontCarePos,_,_,_) -> 
172
173
         true
173
174
     | _ ->
174
175
         match info with
184
185
  let tag_with_mck mck ib = fun tin -> 
185
186
 
186
187
    let cocciinforef = ib.Ast_c.cocci_tag in
187
 
    let (oldmcode, oldenv) = !cocciinforef in
 
188
    let (oldmcode, oldenv) = Ast_c.mcode_and_env_of_cocciref cocciinforef in
188
189
 
189
190
    let mck =
190
191
      (* coccionly: 
202
203
    );
203
204
 
204
205
    match (oldmcode,mck) with
205
 
    | (Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING),      _)
 
206
    | (Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING),  _)
206
207
    | (_,   Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING)) 
207
208
      ->
208
 
        cocciinforef := (mck, tin.binding);
 
209
        let update_inst inst = function
 
210
            Ast_cocci.MINUS (pos,_,adj,any_xxs) ->
 
211
              Ast_cocci.MINUS (pos,inst,adj,any_xxs)
 
212
          | mck -> mck in
 
213
        cocciinforef := Some (update_inst tin.extra.index mck, tin.binding);
209
214
        ib
210
215
 
 
216
    | (Ast_cocci.MINUS(old_pos,old_inst,old_adj,[]),
 
217
       Ast_cocci.MINUS(new_pos,new_inst,new_adj,[]))
 
218
        when old_pos = new_pos && oldenv =*= tin.binding
 
219
            (* no way to combine adjacency information, just drop one *)
 
220
      ->
 
221
        cocciinforef := Some
 
222
          (Ast_cocci.MINUS
 
223
             (old_pos,Common.union_set old_inst new_inst,old_adj,[]),
 
224
           tin.binding);
 
225
        (if !Flag_matcher.show_misc
 
226
        then pr2 "already tagged but only removed, so safe");
 
227
        ib
 
228
 
211
229
    | _ -> 
212
 
        if (oldmcode, oldenv) =*= (mck, tin.binding)
213
 
        then begin
214
 
          if !Flag_matcher.show_misc
215
 
          then pr2 "already tagged but with same mcode, so safe";
216
 
          ib
217
 
        end
218
 
        else 
219
230
          (* coccionly: 
220
231
          if !Flag.sgrep_mode2
221
232
          then ib (* safe *)
222
233
          else 
223
234
          *)
224
235
             begin
225
 
            (* coccionly:
226
 
              Format.set_formatter_out_channel stderr;
227
 
              Common.pr2 "SP mcode ";
228
 
              Pretty_print_cocci.print_mcodekind oldmcode;
229
 
              Format.print_newline();
230
 
              Common.pr2 "C code mcode ";
231
 
              Pretty_print_cocci.print_mcodekind mck;
232
 
              Format.print_newline();
233
 
              Format.print_flush();
234
 
            *)
235
 
              failwith
 
236
            (* coccionly: 
 
237
               pad: if dont want cocci write:
 
238
                failwith
236
239
                (match Ast_c.pinfo_of_info ib with
237
240
                  Ast_c.FakeTok _ -> "already tagged fake token"
 
241
             *)
 
242
               let pm str mcode env =
 
243
                 Printf.sprintf
 
244
                   "%s modification:\n%s\nAccording to environment:\n%s\n"
 
245
                   str
 
246
                   (Common.format_to_string
 
247
                      (function _ ->
 
248
                        Pretty_print_cocci.print_mcodekind mcode))
 
249
                   (String.concat "\n"
 
250
                      (List.map
 
251
                         (function ((r,vr),vl) ->
 
252
                           Printf.sprintf "   %s.%s -> %s" r vr
 
253
                             (Common.format_to_string
 
254
                                (function _ ->
 
255
                                  Pretty_print_engine.pp_binding_kind vl)))
 
256
                         env)) in
 
257
               flush stdout; flush stderr;
 
258
               Common.pr2
 
259
                 ("\n"^ (pm "previous" oldmcode oldenv) ^ "\n" ^
 
260
                  (pm "current" mck tin.binding));
 
261
               failwith
 
262
                 (match Ast_c.pinfo_of_info ib with
 
263
                   Ast_c.FakeTok _ ->
 
264
                     Common.sprintf "%s: already tagged fake token\n"
 
265
                       tin.extra.current_rule_name
238
266
                | _ ->
239
 
                    Common.sprintf "%s: already tagged token:\n%s"
 
267
                    Printf.sprintf
 
268
                      "%s: already tagged token:\nC code context\n%s"
240
269
                      tin.extra.current_rule_name
241
270
                      (Common.error_message (Ast_c.file_of_info ib)
242
271
                         (Ast_c.str_of_info ib, Ast_c.opos_of_info ib)))
276
305
 
277
306
  let distribute_mck mcodekind distributef expr tin =
278
307
    match mcodekind with
279
 
    | Ast_cocci.MINUS (pos,any_xxs) -> 
 
308
    | Ast_cocci.MINUS (pos,_,adj,any_xxs) -> 
 
309
        let inst = tin.extra.index in
280
310
        distributef (
281
 
          (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,any_xxs)) ib tin),
282
 
          (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,[])) ib tin),
283
 
          (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,[])) ib tin),
284
 
          (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,any_xxs)) ib tin)
 
311
          (fun ib ->
 
312
            tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,any_xxs)) ib tin),
 
313
          (fun ib ->
 
314
            tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,[])) ib tin),
 
315
          (fun ib ->
 
316
            tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,[])) ib tin),
 
317
          (fun ib ->
 
318
            tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,any_xxs)) ib tin)
285
319
        ) expr
286
320
    | Ast_cocci.CONTEXT (pos,any_befaft) -> 
287
321
        (match any_befaft with
382
416
   let get_pos mck = 
383
417
     match mck with
384
418
     | Ast_cocci.PLUS -> raise Impossible
385
 
     | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_) 
386
 
     | Ast_cocci.MINUS   (Ast_cocci.FixPos (i1,i2),_) -> 
 
419
     | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_)
 
420
     | Ast_cocci.MINUS   (Ast_cocci.FixPos (i1,i2),_,_,_) -> 
387
421
         Ast_cocci.FixPos (i1,i2)
388
 
     | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_) 
389
 
     | Ast_cocci.MINUS   (Ast_cocci.DontCarePos,_) -> 
 
422
     | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_)
 
423
     | Ast_cocci.MINUS   (Ast_cocci.DontCarePos,_,_,_) -> 
390
424
         Ast_cocci.DontCarePos
391
425
     | _ -> failwith "weird: dont have position info for the mcodekind"      
392
426
      
498
532
 
499
533
let (transform2: string (* rule name *) -> string list (* dropped_isos *) ->
500
534
  Lib_engine.metavars_binding (* inherited bindings *) ->
501
 
  Lib_engine.transformation_info -> F.cflow -> F.cflow) = 
 
535
  Lib_engine.numbered_transformation_info -> F.cflow -> F.cflow) = 
502
536
 fun rule_name dropped_isos binding0 xs cflow -> 
503
537
 
504
538
   let extra = { 
506
540
     optional_qualifier_iso = not(List.mem "optional_qualifier" dropped_isos);
507
541
     value_format_iso = not(List.mem "value_format" dropped_isos);
508
542
     current_rule_name = rule_name;
 
543
     index = [];
509
544
   } in
510
545
 
511
546
  (* find the node, transform, update the node,  and iter for all elements *)
512
547
 
513
 
   xs +> List.fold_left (fun acc (nodei, binding, rule_elem) -> 
 
548
   xs +> List.fold_left (fun acc (index, (nodei, binding, rule_elem)) -> 
514
549
      (* subtil: not cflow#nodes but acc#nodes *)
515
550
      let node  = acc#nodes#assoc nodei in 
516
551
 
517
552
      if !Flag.show_transinfo
518
553
      then pr2 "transform one node";
519
 
      
 
554
 
520
555
      let tin = {
521
 
        XTRANS.extra = extra;
 
556
        XTRANS.extra = {extra with index = index};
522
557
        XTRANS.binding = binding0@binding;
523
558
        XTRANS.binding0 = []; (* not used - everything constant for trans *)
524
559
      } in