File: compare_c.ml

package info (click to toggle)
coccinelle 1.0.8.deb-5
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 26,148 kB
  • sloc: ml: 136,392; ansic: 23,594; sh: 2,189; makefile: 2,157; perl: 1,576; lisp: 840; python: 823; awk: 70; csh: 12
file content (368 lines) | stat: -rw-r--r-- 12,131 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
(* Yoann Padioleau
 *
 * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
 * Copyright (C) 2006, 2007 Ecole des Mines de Nantes
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License (GPL)
 * version 2 as published by the Free Software Foundation.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * file license.txt for more details.
 *)
open Common

open Ast_c


type compare_result =
  | Correct
  | Pb of string
  | PbOnlyInNotParsedCorrectly of string


(*****************************************************************************)
(* Normalise before comparing *)
(*****************************************************************************)

(* List taken from CVS manual, 'Keyword substitution' chapter. Note
 * that I do not put "Log" because it is used only in comment, and it
 * is not enough to substituate until the end of the line. *)
let cvs_keyword_list = [
  "Id";"Date"; "Revision"; (* the common one *)
  "FreeBSD";"Heimdal";"KAME";"NetBSD";"OpenBSD";"OpenLDAP";"RuOBSD";
  "SourceForge";
  "Name";"Author";"CVSHeader";"Header";"Locker";"RCSfile";"Source";"State";
  "Rev";
]

(* Can also have just dollarIDdollar but it is only when you have not
 * yet committed the file. After the commit it would be a dollarIddollar:.
 * If reput Id:, do not join the regexp!! otherwise CVS will modify it :)
 *)
let cvs_keyword_regexp = Str.regexp
  ("\\$\\([A-Za-z_]+\\):[^\\$]*\\$")


let cvs_compute_newstr s =
  Str.global_substitute cvs_keyword_regexp (fun _s ->
    let substr = Str.matched_string s in
    assert (substr ==~ cvs_keyword_regexp); (* use its side-effect *)
    let tag = matched1 substr in

    if not (List.mem tag cvs_keyword_list)
    then pr2_once ("unknown CVS keyword: " ^ tag);

    "CVS_MAGIC_STRING"
  ) s




(* todo: get rid of the type for expressions  ? *)
let normal_form_program xs =
  let bigf = { Visitor_c.default_visitor_c_s with

    Visitor_c.kini_s = (fun (k,bigf) ini ->
      match ini with
      | InitList xs, [i1;i2;iicommaopt] ->
          k (InitList xs, [i1;i2])
      | _ -> k ini
    );

    Visitor_c.kexpr_s = (fun (k,bigf) e ->
      match e with
      (* todo: should also do something for multistrings *)
      |	 (Constant (String (s,kind)), typ), [ii]
          when Common.string_match_substring cvs_keyword_regexp s ->
          let newstr = cvs_compute_newstr s in
          (Constant (String (newstr,kind)), typ), [rewrap_str newstr ii]
      |	 _ -> k e
    );

    Visitor_c.kfragment_s = (fun (k,bigf) e ->
      match e with
      (* todo: should also do something for multistrings *)
      | (ConstantFragment s), [ii]
          when Common.string_match_substring cvs_keyword_regexp s ->
          let newstr = cvs_compute_newstr s in
	  (ConstantFragment newstr), [rewrap_str newstr ii]
      | _ -> k e
    );

    Visitor_c.ktoplevel_s = (fun (k,bigf) p ->
      match p with
      | CppTop (Define _) ->
          raise Todo
          (*
          let (i1, i2, i3) = Common.tuple_of_list3 ii in
          if Common.string_match_substring cvs_keyword_regexp body
          then
            let newstr = cvs_compute_newstr body in
            Define ((s, newstr), [i1;i2;rewrap_str newstr i3])
          else p
          *)
      | _ -> k p
    );

(*
    Visitor_c.kinfo_s = (fun (k,bigf) i ->
      let s = Ast_c.get_str_of_info i in
      if Common.string_match_substring cvs_keyword_regexp s
      then
        let newstr = cvs_compute_newstr s in
        rewrap_str newstr i
      else i
    );
*)

  }
  in
  xs +> List.map (fun p -> Visitor_c.vk_toplevel_s  bigf p)






let normal_form_token adjust_cvs x =
  let x' =
    match x with
    | Parser_c.TString ((s, kind),i1) -> Parser_c.TString (("",kind), i1)
    | Parser_c.TIfdef (_,_,i) -> Parser_c.TIfdef (Gnone,ref None,i)
    | Parser_c.TIfdefelif (_,_,i) -> Parser_c.TIfdefelif (Gnone,ref None,i)
    | Parser_c.TEndif (_,i) -> Parser_c.TEndif (ref None,i)
    | Parser_c.TIfdefelse (_,i) -> Parser_c.TIfdefelse (ref None,i)
    | Parser_c.TIfdefBool (b,_,i) -> Parser_c.TIfdefBool (b,ref None,i)
    | Parser_c.TIfdefMisc (b,_,i) -> Parser_c.TIfdefMisc (b,ref None,i)
    | Parser_c.TIfdefVersion (b,_,i) -> Parser_c.TIfdefVersion (b,ref None,i)
    | x -> x
  in
  x' +> Token_helpers.visitor_info_of_tok (fun info ->
    let info = Ast_c.al_info 0 info in
    let str = Ast_c.str_of_info info in
    if adjust_cvs && Common.string_match_substring cvs_keyword_regexp str
    then
      let newstr = cvs_compute_newstr str in
      rewrap_str newstr info
    else info
  )


(*****************************************************************************)
(* Compare at Ast level *)
(*****************************************************************************)

(* Note that I do a (simple) astdiff to know if there is a difference, but
 * then I use diff to print the differences. So sometimes you have to dig
 * a little to find really where the real difference (one not involving
 * just spacing difference) was.
 * Note also that the astdiff is not very accurate. As I skip comments,
 * macro definitions, those are not in the Ast and if there is a diff
 * between 2 files regarding macro def, then I will not be able to report it :(
 * update: I now put the toplevel #define at least in the Ast.
 * update: You can use token_compare for more precise diff.
 *
 * todo?: finer grain astdiff, better report, more precise.
 *
 * todo: do iso between if() S and  if() { S }
 *)
(* I have removed this function as it was not used anywhere.
 *     let compare_ast filename1 filename2  = ...
 * /Iago
 *)


(*****************************************************************************)
(* Compare at token level *)
(*****************************************************************************)

(* Because I now commentize more in parsing, with parsing_hacks,
 * compare_ast may say that 2 programs are equal whereas they are not.
 * Here I compare token, and so have still the TCommentCpp and TCommentMisc
 * so at least detect such differences.
 *
 * Moreover compare_ast is not very precise in his report when it
 * detects a difference. So token_diff is better.
 *
 * I do token_diff but I use programCelement2, so that
 * I know if I am in a "notparsable" zone. The tokens are
 * in (snd programCelement2).
 *
 * Faire aussi un compare_token qui se moque des TCommentMisc,
 * TCommentCPP et TIfdef ? Normalement si fait ca retrouvera
 * les meme resultats que compare_ast.
 *
 *)


(* Pass only "true" comments, don't pass TCommentMisc and TCommentCpp *)
let is_normal_space_or_comment to_expected = function
  | Parser_c.TCommentSpace _
  | Parser_c.TCommentNewline _

(*  | Parser_c.TComma _ *) (* UGLY, because of gcc_opt_comma isomorphism  *)
      -> true
  | Parser_c.TComment _ -> to_expected (* only ignore in compare to expected *)
  | _ -> false

let get_diff filename1 filename2 bs =
  let com =
    match !Flag_parsing_c.diff_lines with
      None -> Printf.sprintf "diff -u %s %s %s" bs filename1 filename2
    | Some n ->
	Printf.sprintf "diff -U %s %s %s %s" n bs filename1 filename2 in
  let xs = Common.cmd_to_list com in

  (* get rid of the --- and +++ lines *)
  if xs=[]
  then xs
  else Common.drop 2 xs

(* convention: compare_token generated_file  expected_res
 * because when there is a notparsablezone in generated_file, I
 * don't issue a PbOnlyInNotParsedCorrectly
 *)
let do_compare_token adjust_cvs to_expected filename1 filename2 =

  let rec loop xs ys =
    match xs, ys with
    | [], [] -> None

    (* UGLY, because of gcc_opt_comma isomorphism  *)
    | (Parser_c.TComma _::Parser_c.TCBrace _::xs),  (Parser_c.TCBrace _::ys) ->
        loop xs ys
    | (Parser_c.TCBrace _::xs), (Parser_c.TComma _::Parser_c.TCBrace _::ys) ->
        loop xs ys

    | [], x::xs ->
        Some "not same number of tokens inside C elements"
    | x::xs, [] ->
        Some "not same number of tokens inside C elements"

    | x::xs, y::ys ->
        let x' = normal_form_token adjust_cvs x in
        let y' = normal_form_token adjust_cvs y in
        if x' = y'
        then loop xs ys
        else
          let str1, pos1 =
            Token_helpers.str_of_tok x, Token_helpers.pos_of_tok x in
          let str2, pos2 =
            Token_helpers.str_of_tok y, Token_helpers.pos_of_tok y in
	  (*
	  let str1 = str1 ^ " - " ^ (Token_helpers.string_of_token x) in
	  let str2 = str2 ^ " - " ^ (Token_helpers.string_of_token y) in
	  *)
          Some ("diff token: " ^ str1 ^" VS " ^ str2 ^ "\n" ^
                   Common.error_message filename1 (str1, pos1) ^ "\n" ^
                   Common.error_message filename2 (str2, pos2) ^ "\n"
          )

  in
  let final_loop xs ys =
    loop
      (xs +>
       List.filter (fun x -> not (is_normal_space_or_comment to_expected x)))
      (ys +>
       List.filter (fun x -> not (is_normal_space_or_comment to_expected x)))
  in

  (*
    let toks1 = Parse_c.tokens filename1 in
    let toks2 = Parse_c.tokens filename2 in
    loop toks1 toks2 in
  *)

  let do_parse filename other =
    if Filename.dirname filename = "/tmp"
    then
      (* hack to make include paths similar for generated and original files *)
      let pth = !Includes.include_path in
      let dir = Filename.dirname other in
      let ps = Includes.get_parsing_style() in
      (match ps with
	Includes.Parse_local_includes ->
	  Includes.set_parsing_style Parse_all_includes;
	  Includes.include_path := [dir]
      | _ -> Includes.include_path := dir :: pth);
      let (c2, _stat) = Parse_c.parse_c_and_cpp false false filename in
      Includes.set_parsing_style ps;
      Includes.include_path := pth;
      c2
    else fst(Parse_c.parse_c_and_cpp false false filename) in

  let c1 = do_parse filename1 filename2 in
  let c2 = do_parse filename2 filename1 in

  let res =
    if List.length c1 <> List.length c2
    then Pb "not same number of entities (func, decl, ...)"
    else
        zip c1 c2 +> Common.fold_k (fun acc ((a,infoa),(b,infob)) k ->
          match a, b with
          | NotParsedCorrectly a, NotParsedCorrectly b ->
              (match final_loop (snd infoa) (snd infob) with
              | None -> k acc
              | Some s -> PbOnlyInNotParsedCorrectly s
              )

          | NotParsedCorrectly a, _ ->
              Pb "PB parsing only in generated-file"
          | _, NotParsedCorrectly b ->
              PbOnlyInNotParsedCorrectly "PB parsing only in expected-file"
          | _, _ ->
              (match final_loop (snd infoa) (snd infob) with
              | None  -> k acc
              | Some s -> Pb s
              )
        ) (fun acc -> acc)
          (Correct)
  in

  let xs = get_diff filename1 filename2 "-b -B" in

  (if xs=[] && (res <> Correct)
  then Printf.eprintf "%s %s"
    "Impossible: How can diff be null and have not Correct in compare_c?"
      (Dumper.dump res))

;

  res, xs

let compare_token = do_compare_token true true


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

(* compare to a res file *)
let compare_default = do_compare_token true true

(* compare to the source of the transformation *)
let compare_to_original = do_compare_token false false

let exact_compare file1 file2 =
  match get_diff file1 file2 "" with
    [] -> (Correct, [])
  | res -> (Pb "files differ", res)

let compare_result_to_string (correct, diffxs) =
  match correct with
  | Correct ->
      "seems correct" ^ "\n"
  | Pb s ->
      ("seems incorrect: " ^ s) ^ "\n" ^
        "diff (result(-) vs expected_result(+)) = " ^ "\n" ^
        (diffxs +> String.concat "\n") ^ "\n"
  | PbOnlyInNotParsedCorrectly s ->
      "seems incorrect, but only because of code that was not parsable" ^ "\n"^
        ("explanation:" ^ s) ^ "\n" ^
        "diff (result(-) vs expected_result(+)) = " ^ "\n" ^
        (diffxs +> String.concat "\n") ^ "\n"


let compare_result_to_bool correct =
  correct = Correct