Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: 3bdc4f1d95
Fetching contributors…

Cannot retrieve contributors at this time

489 lines (427 sloc) 15.291 kB
(* Yoann Padioleau
*
* Copyright (C) 2006 Yoann Padioleau
* Copyright (C) 2010 Facebook
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* version 2.1 as published by the Free Software Foundation, with the
* special exception on linking described in file license.txt.
*
* This library 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
(*****************************************************************************)
(* Prelude *)
(*****************************************************************************)
(*
* history:
* Was first written for coccinelle, for patchparse experiment.
*
*
* note: diff can have some ambuiguities ? ex:
* file1:
*
* -- /home/pad/week-end/cocci-c/txt/file1 2006-02-16 11:32:00.000000000 +0100
*
* file2:
*
* -- titi
*
* => Diff:
*
* diff -u -p -b -B -r /home/pad/week-end/cocci-c/txt/file1 /home/pad/week-end/cocci-c/txt/file2
* --- /home/pad/week-end/cocci-c/txt/file1 2006-02-16 11:32:38.000000000 +0100
* +++ /home/pad/week-end/cocci-c/txt/file2 2006-02-16 11:32:07.000000000 +0100
* @@ -1 +1 @@
* --- /home/pad/week-end/cocci-c/txt/file1 2006-02-16 11:32:00.000000000 +0100
* +-- titi
* \ No newline at end of file
*
* ambiguity ? no because there is a preceding diff line command
*
*
*
* todo:
* in fact fragile, cf txt/diff_format.txt,
* "^--- " is not enough for a regexp, there must be just before a diff command
* todo?: does it handle when a file was just created/deleted ?
* --- a/drivers/acorn/char/defkeymap-acorn.c_shipped Sat Jun 14 12:18:56 2003
* +++ /dev/null Wed Dec 31 16:00:00 1969
* does it need to ? (I think no, after all, if deleted or created, there is no
* interesting patch info to print)
*
* in main.ml:
*
* let classic_patch_file = ref ""
* "-classic_patch_file", Arg.Set_string classic_patch_file,
* " the patch file corresponding to the linux version we are analyzing" ;
* ] in
*
* | "test_parse_classic_patch", [] ->
* Classic_patch.parse_patch (cat "/tmp/patch1") +> ignore
*
* | "test_filter_driver", [] ->
* cat "/home/pad/kernels/patches/patch-2.5.71"
* +> Classic_patch.filter_driver_sound
* +> List.iter pr2
*
*)
(*****************************************************************************)
(* Types *)
(*****************************************************************************)
type patch_raw = string list
(* parsing patch related *)
type patchinfo = (filename, fileinfo) Common.assoc
and fileinfo = ((int * int) * hunk) list
(* inv: the regions are sorted, because we process patch from start to
* end of file *)
and hunk = string list
(* with tarzan *)
(* the strings are without the mark *)
type patchline =
| Context of string
| Minus of string
| Plus of string
let mark_regexp = "^[-+ ]"
let regexp_mark_and_line = "^\\([-+ ]\\)\\(.*\\)"
let str_regexp_no_mark = "^[-+ ]\\(.*\\)"
type stat = {
mutable nb_minus: int;
mutable nb_plus: int
}
let verbose = false
(* generating patch related *)
type edition_cmd =
| RemoveLines of int list
| PreAddAt of int * string list
| PostAddAt of int * string list
(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)
let remove_prefix_mark s =
if s =~ str_regexp_no_mark
then matched1 s
else begin
pr2 ("no mark in: " ^ s);
s
end
let parse_hunk xs =
xs +> List.map (fun s ->
if s=~ regexp_mark_and_line
then
let (mark, rest_line) = Common.matched2 s in
(match mark with
| " " -> Context rest_line
| "-" -> Minus rest_line
| "+" -> Plus rest_line
| _ -> raise Impossible
)
else
failwith ("wrong format for a hunk: " ^ s)
)
let rec mark_file_boundary_and_normalize_with_xxx xs =
match xs with
| [] -> []
| x::xs ->
if x =~ "^diff .*"
then
let has_minus_and_plus =
match xs with
| y::z::xs ->
y =~ "--- \\(.*\\)" &&
z =~ "\\+\\+\\+ \\(.*\\)"
| _ -> false
in
if has_minus_and_plus
then
(match xs with
| y::z::xs ->
(* ugly *)
let _ = y =~ "--- \\(.*\\)" in
let s_y = matched1 y in
let _ = z =~ "\\+\\+\\+ \\(.*\\)" in
let s_z = matched1 z in
if s_y = "/dev/null"
then ("xxx " ^ s_z)::mark_file_boundary_and_normalize_with_xxx xs
else ("xxx " ^ s_y)::mark_file_boundary_and_normalize_with_xxx xs
| _ -> raise Impossible
)
else begin
match xs with
| x::xs when x =~ "Binary files .*" ->
mark_file_boundary_and_normalize_with_xxx xs
| _ ->
if verbose
then pr2 ("weird, diff header but no modif: " ^ x);
mark_file_boundary_and_normalize_with_xxx (xs)
end
else
x::mark_file_boundary_and_normalize_with_xxx xs
(*****************************************************************************)
(* Main entry point *)
(*****************************************************************************)
let (parse_patch: (string list) -> patchinfo) = fun lines ->
(* dont need those lines any more *)
(* old:
* let lines = lines +> List.filter (fun s ->
* not (s =~ "^\\-\\-\\-" || s =~ "^diff"))
* in
* but this does not handle well patches that remove or mv files which
* will contain some +++ /dev/null or ---/dev/null so just normalize it
*)
let lines = mark_file_boundary_and_normalize_with_xxx lines in
(* note: split_list_regexp can generate __noheading__ category
* (cf common.ml code)
*)
let double_splitted =
lines
+> Common.split_list_regexp "^xxx "
+> List.map (fun (s, group) ->
(s, split_list_regexp "^@@" group)
)
in
double_splitted +>
List.map (fun (s, group) ->
if s =~ "^xxx [^/]+/\\([^ \t]+\\)[ \t]?"
then
(* old:
s =~ "^\\-\\-\\- [^/]+/\\([^/]+\\)/\\(.*\\)/\\([^ \t]+\\)[ \t]"
+> (fun b -> if not b then (pr2 s; pr2 (dump group); assert b));
let (driver_or_sound, subdirs, filename) = matched3 s in
assert drivers|sound
driver_or_sound ^ "/" ^ subdirs ^ "/" ^ filename,
*)
let (file) = matched1 s in
file,
group +>
List.map (fun (s, group) ->
match () with
| _ when
s =~ "^@@ \\-\\([0-9]+\\),\\([0-9]+\\) \\+\\([0-9]+\\),\\([0-9]+\\) @@" ->
let (start1, plus1, _start2, _plus2) = matched4 s in
let (start1, plus1) = pair s_to_i (start1, plus1) in
((start1, start1 + plus1),
(* just put the +- into the string ? *)
group
)
(* [("@@ -1 +0,0 @@", ["-"])] *)
| _ when
s =~ "^@@ \\-\\([0-9]+\\) \\+\\([0-9]+\\),\\([0-9]+\\) @@" ->
let (start1, _start2, _plus2) = matched3 s in
let (start1, plus1) = pair s_to_i (start1, "0") in
((start1, start1 + plus1),
(* just put the +- into the string ? *)
group
)
(* @@ -0,0 +1 @@ *)
| _ when
s =~ "^@@ \\-\\([0-9]+\\),\\([0-9]+\\) \\+\\([0-9]+\\) @@" ->
let (start1, plus1, _start2) = matched3 s in
let (start1, plus1) = pair s_to_i (start1, plus1) in
((start1, start1 + plus1),
(* just put the +- into the string ? *)
group
)
(* @@ -1 +1 @@ *)
| _ when
s =~ "^@@ \\-\\([0-9]+\\) \\+\\([0-9]+\\) @@" ->
let (start1, _start2) = matched2 s in
let (start1) = s_to_i start1 in
((start1, start1),
(* just put the +- into the string ? *)
group
)
| _ -> failwith ("pb with hunk: " ^ s)
)
else failwith ("pb with line: " ^ s)
)
(*****************************************************************************)
(* Hunk processing *)
(*****************************************************************************)
let hunk_containing_string s (pinfos: patchinfo) =
pinfos +> Common.find_some (fun (file, fileinfo) ->
Common.optionise (fun () ->
fileinfo +> Common.find_some (fun (limits, hunk) ->
let hunk' = hunk +> List.map remove_prefix_mark in
if List.mem s hunk'
then Some hunk
else None
))
)
let hunks_containing_string s (pinfos: patchinfo) =
pinfos +> Common.map_filter (fun (file, fileinfo) ->
let res =
(fileinfo +> Common.map_filter (fun (limits, hunk) ->
let hunk' = hunk +> List.map remove_prefix_mark in
if List.mem s hunk'
then Some hunk
else None
))
in
if null res then None else Some res
) +> List.flatten
let modified_lines fileinfo =
fileinfo |> List.map (fun ((start, _end), hunk) ->
let hunk = parse_hunk hunk in
let noplus = hunk |> Common.exclude (function Plus _ -> true | _ -> false)
in
Common.index_list noplus |> Common.map_filter (function
| Minus _, idx -> Some (idx + start)
| _ -> None
)
) |> List.flatten
(*****************************************************************************)
(* Extra func *)
(*****************************************************************************)
let diffstat_file finfo =
let plus = ref 0 in
let minus = ref 0 in
finfo +> List.iter (fun (_, hunk) ->
let plines = parse_hunk hunk in
plines +> List.iter (function
| Context _ -> ()
| Minus _ -> incr minus
| Plus _ -> incr plus
);
);
{ nb_minus = !minus;
nb_plus = !plus;
}
let diffstat pinfo =
pinfo |> List.map (fun (file, fileinfo) ->
file, diffstat_file fileinfo
)
let string_of_stat stat =
spf "nb plus = %d, nb minus = %d" stat.nb_plus stat.nb_minus
(*****************************************************************************)
(* misc *)
(*****************************************************************************)
let (relevant_part: (filename * (int * int)) -> patchinfo -> string) =
fun (filename, (startl, endl)) patchinfo ->
raise Todo
(*
try
let xs = patchinfo#find filename in
let is_in i (min, max) = i >= min && i <= max in
xs +> map_filter (fun ((i,j), s) ->
if ((is_in i (startl, endl)) ||
(is_in j (startl, endl)) ||
(i < startl && j > endl))
then Some s
else None
)
+> String.concat "\nOTHER REGION\n"
with Not_found -> ("NO MODIF in patch file for:" ^ filename)
*)
let (filter_driver_sound: string list -> string list) = fun lines ->
raise Todo
(*
let res = ref [] in
let state = ref 0 in
begin
lines +> List.iter (fun s ->
if s =~ "^\\-\\-\\- .*" then state := 0;
(* GET ALSO Documentation, include/*(except asm- ? futur=fs, net *)
(* could filter .h too, newfile *)
if s =~ "^\\-\\-\\- [^/]+/\\([^/]+\\)/\\(.*\\)/\\([a-zA-Z0-9_\\-]+\\.[a-zA-Z0-9_]+\\)[ \t]"
then
let (driver_or_sound, subdirs, filename) = matched3 s in
if driver_or_sound = "drivers" || driver_or_sound = "sound"
then begin state := 1; push2 s res end
else state := 0
else
if s =~ "^\\-\\-\\- .*" then state := 0
else
if !state = 1 then push2 s res
else ()
);
List.rev !res
end
*)
(*****************************************************************************)
(* Patch generation *)
(*****************************************************************************)
(*
* This is sligtly complicated. Modifying files is not that easy.
* A far easier path is to use Emacs and do macros. In most cases it
* is easier than programming the modif in OCaml. I don't have
* enough helper functions for such things. Nevertheless it is not
* always practical to run emacs macros from a script so this is a crude
* but possible alternative.
*
* Could use 'ed' as sgimm suggested, or make a small OCaml API around 'ed'.
*)
let (generate_patch:
edition_cmd list -> filename_in_project:string -> Common.filename ->
string list) =
fun edition_cmds ~filename_in_project filename ->
let indexed_lines =
Common.cat filename +> Common.index_list_1 in
let indexed_lines =
edition_cmds |> List.fold_left (fun indexed_lines edition_cmd ->
match edition_cmd with
| RemoveLines index_lines ->
indexed_lines
+> Common.exclude (fun (line, idx) -> List.mem idx index_lines)
| PreAddAt (lineno, lines_to_add)
| PostAddAt (lineno, lines_to_add) ->
let lines_to_add_fake_indexed =
lines_to_add |> List.map (fun s -> s, -1) in
indexed_lines +> Common.map_flatten (fun (line, idx) ->
if idx = lineno
then
(match edition_cmd with
| PreAddAt _ -> lines_to_add_fake_indexed ++ [line, idx]
| PostAddAt _ -> [line, idx] ++ lines_to_add_fake_indexed
| _ -> raise Impossible
)
else [line, idx]
)
) indexed_lines
in
let lines' = indexed_lines |> List.map fst in
(* generating diff *)
let tmpfile = Common.new_temp_file "genpatch" ".patch" in
write_file ~file:tmpfile (Common.unlines lines');
(* pr2 filename_in_project; *)
let (xs, _) =
Common.cmd_to_list_and_status
(spf "diff -u -p \"%s\" \"%s\"" filename tmpfile)
in
let xs' = xs +> List.map (fun s ->
match () with
| _ when s =~ "^\\-\\-\\- \\([^ \t]+\\)\\([ \t]?\\)" ->
let (_, rest) = matched2 s in
"--- a/" ^ filename_in_project ^ rest
| _ when s =~ "^\\+\\+\\+ \\([^ \t]+\\)\\([ \t]?\\)" ->
let (_, rest) = matched2 s in
"+++ b/" ^ filename_in_project ^ rest
| _ -> s
)
in
xs'
(*****************************************************************************)
(* Debug *)
(*****************************************************************************)
(* generated by ocamltarzan *)
let rec sexp_of_patchinfo v =
Sexp_common.sexp_of_assoc Sexp_common.sexp_of_filename sexp_of_fileinfo v
and sexp_of_fileinfo v =
Conv.sexp_of_list
(fun (v1, v2) ->
let v1 =
match v1 with
| (v1, v2) ->
let v1 = Conv.sexp_of_int v1
and v2 = Conv.sexp_of_int v2
in Sexp.List [ v1; v2 ]
and v2 = sexp_of_hunk v2
in Sexp.List [ v1; v2 ])
v
and sexp_of_hunk v = Conv.sexp_of_list Conv.sexp_of_string v
let string_of_patchinfo x =
x |> sexp_of_patchinfo |> Sexp.to_string_hum
Jump to Line
Something went wrong with that request. Please try again.