Add a ~p parameter to Patch.parse mimicking the behaviour of patch -p<num>

src/patch.ml

@@ -161,33 +161,18 @@ let operation_eq a b = match a, b with
 
 let no_file = "/dev/null"
 
-let pp_operation ~git ppf op =
-  let real_name direction name =
-    if git then name else
-      match direction with `Mine -> "a/" ^ name | `Theirs -> "b/" ^ name
-  in
-  let hdr mine their =
-    (* even if create/delete, /dev/null is not used in this header *)
-    (* according to git documentation *)
-    if git then
-      Format.fprintf ppf "diff --git %s %s\n"
-        (real_name `Mine mine) (real_name `Theirs their)
-  in
+let pp_operation ppf op =
   match op with
   | Edit (old_name, new_name) ->
-    hdr old_name new_name ;
-    Format.fprintf ppf "--- %s\n" (real_name `Mine old_name) ;
-    Format.fprintf ppf "+++ %s\n" (real_name `Theirs new_name)
+    Format.fprintf ppf "--- %s\n" old_name ;
+    Format.fprintf ppf "+++ %s\n" new_name
   | Delete name ->
-    hdr name name ;
-    Format.fprintf ppf "--- %s\n" (real_name `Mine name) ;
+    Format.fprintf ppf "--- %s\n" name ;
     Format.fprintf ppf "+++ %s\n" no_file
   | Create name ->
-    hdr name name ;
     Format.fprintf ppf "--- %s\n" no_file ;
-    Format.fprintf ppf "+++ %s\n" (real_name `Theirs name)
+    Format.fprintf ppf "+++ %s\n" name
   | Rename_only (old_name, new_name) ->
-    hdr old_name new_name ;
     Format.fprintf ppf "rename from %s\n" old_name;
     Format.fprintf ppf "rename to %s\n" new_name
 
@@ -198,8 +183,8 @@ type t = {
   their_no_nl : bool ;
 }
 
-let pp ~git ppf {operation; hunks; mine_no_nl; their_no_nl} =
-  pp_operation ~git ppf operation;
+let pp ppf {operation; hunks; mine_no_nl; their_no_nl} =
+  pp_operation ppf operation;
   let rec aux = function
     | [] -> ()
     | [x] -> pp_hunk ~mine_no_nl ~their_no_nl ppf x
@@ -209,48 +194,43 @@ let pp ~git ppf {operation; hunks; mine_no_nl; their_no_nl} =
   in
   aux hunks
 
-let pp_list ~git ppf diffs =
-  List.iter (Format.fprintf ppf "%a" (pp ~git)) diffs
+let pp_list ppf diffs =
+  List.iter (Format.fprintf ppf "%a" pp) diffs
 
-(* TODO: remove this and let users decide the prefix level they want *)
-let process_git_prefix ~git ~prefix s =
-  if git && String.is_prefix ~prefix s then
-    String.slice ~start:(String.length prefix) s
+let strip_prefix ~p filename =
+  if p = 0 then
+    filename
   else
-    s
+    match String.cuts '/' filename with
+    | [] -> assert false
+    | x::xs ->
+        (* Per GNU patch's spec: A sequence of one or more adjacent slashes is counted as a single slash. *)
+        let filename = x :: List.filter (function "" -> false | _ -> true) xs in
+        String.concat "/" (drop filename p)
 
-let operation_of_strings git mine their =
+let operation_of_strings ~p mine their =
   let mine_fn = String.slice ~start:4 mine
   and their_fn = String.slice ~start:4 their in
   match Fname.parse mine_fn, Fname.parse their_fn with
-  | Ok None, Ok (Some b) ->
-      let b = process_git_prefix ~git ~prefix:"b/" b in
-      Create b
-  | Ok (Some a), Ok None ->
-      let a = process_git_prefix ~git ~prefix:"a/" a in
-      Delete a
-  | Ok (Some a), Ok (Some b) ->
-      let a = process_git_prefix ~git ~prefix:"a/" a in
-      let b = process_git_prefix ~git ~prefix:"b/" b in
-      Edit (a, b)
+  | Ok None, Ok (Some b) -> Create (strip_prefix ~p b)
+  | Ok (Some a), Ok None -> Delete (strip_prefix ~p a)
+  | Ok (Some a), Ok (Some b) -> Edit (strip_prefix ~p a, strip_prefix ~p b)
   | Ok None, Ok None -> assert false (* ??!?? *)
   | Error msg, _ -> raise (Parse_error {msg; lines = [mine]})
   | _, Error msg -> raise (Parse_error {msg; lines = [their]})
 
-let parse_one data =
+let parse_one ~p data =
   (* first locate --- and +++ lines *)
-  let rec find_start git ?hdr = function
+  let rec find_start ?hdr = function
     | [] -> hdr, []
-    | x::xs when String.is_prefix ~prefix:"diff --git " x ->
-      begin match hdr with None -> find_start true xs | Some _ -> hdr, x::xs end
     | x::y::xs when String.is_prefix ~prefix:"rename from " x && String.is_prefix ~prefix:"rename to " y ->
       let hdr = Rename_only (String.slice ~start:12 x, String.slice ~start:10 y) in
-      find_start git ~hdr xs
+      find_start ~hdr xs
     | x::y::xs when String.is_prefix ~prefix:"--- " x ->
-      Some (operation_of_strings git x y), xs
-    | _::xs -> find_start git ?hdr xs
+      Some (operation_of_strings ~p x y), xs
+    | _::xs -> find_start ?hdr xs
   in
-  match find_start false data with
+  match find_start data with
   | Some (Rename_only _ as operation), rest ->
     let hunks = [] and mine_no_nl = false and their_no_nl = false in
     Some ({ operation ; hunks ; mine_no_nl ; their_no_nl }, rest)
@@ -262,15 +242,15 @@ let parse_one data =
 
 let to_lines = String.cuts '\n'
 
-let parse data =
+let parse ~p data =
   let lines = to_lines data in
-  let rec doit acc = function
+  let rec doit ~p acc = function
     | [] -> List.rev acc
-    | xs -> match parse_one xs with
+    | xs -> match parse_one ~p xs with
       | None -> List.rev acc
-      | Some (diff, rest) -> doit (diff :: acc) rest
+      | Some (diff, rest) -> doit ~p (diff :: acc) rest
   in
-  doit [] lines
+  doit ~p [] lines
 
 let patch filedata diff =
   match diff.operation with

src/patch.mli

@@ -28,12 +28,11 @@ type operation =
   | Create of string
   | Rename_only of string * string
   (** The operation of a diff: in-place [Edit], [Delete], [Create], [Rename_only].
-      The parameters to the variants are filenames. *)
+      The parameters to the variants are filenames.
+      NOTE: in a typical git diff file, [Rename_only] does not have any prefix. *)
 
-val pp_operation : git:bool -> Format.formatter -> operation -> unit
-(** [pp_operation ~git ppf op] pretty-prints the operation [op] on [ppf], If
-    [git] is true, the [git diff] style will be output (a
-    "diff --git oldfilename newfilename" line, etc). *)
+val pp_operation : Format.formatter -> operation -> unit
+(** [pp_operation ppf op] pretty-prints the operation [op] on [ppf]. *)
 
 val operation_eq : operation -> operation -> bool
 (** [operation_eq a b] is true if [a] and [b] are equal. *)
@@ -47,16 +46,18 @@ type t = {
 (** The type of a diff: an operation, a list of hunks, and information whether
     a trailing newline exists on the left and right. *)
 
-val pp : git:bool -> Format.formatter -> t -> unit
-(** [pp ~git ppf t] pretty-prints [t] on [ppf]. If [git] is true, "git diff"
-    style will be printed. *)
+val pp : Format.formatter -> t -> unit
+(** [pp ppf t] pretty-prints [t] on [ppf]. *)
 
-val pp_list : git:bool -> Format.formatter -> t list -> unit
-(** [pp ~git ppf diffs] pretty-prints [diffs] on [ppf]. If [git] is true,
-    "git diff" style will be printed. *)
+val pp_list : Format.formatter -> t list -> unit
+(** [pp ppf diffs] pretty-prints [diffs] on [ppf]. *)
 
-val parse : string -> t list
-(** [parse data] decodes [data] as a list of diffs.
+val parse : p:int -> string -> t list
+(** [parse ~p data] decodes [data] as a list of diffs.
+
+    @param p denotes the expected prefix level of the filenames.
+    For more information, see the option [-p] in your POSIX-complient
+    patch.
 
     @raise Parse_error if a filename was unable to be parsed *)
 

src/patch_command.ml

@@ -6,15 +6,15 @@
 
 let usage =
   "Simplified patch utility for single-file patches;\n
-   ./patch.exe <input-file> <unififed-diff-file> -o <output-file>"
+   ./patch.exe -p<num> <input-file> <unified-diff-file> -o <output-file>"
 
 let exit_command_line_error = 1
 let exit_open_error = 2
 let exit_several_chunks = 3
 let exit_patch_failure = 4
 
-let run ~input ~diff =
-  match Patch.parse diff with
+let run ~p ~input ~diff =
+  match Patch.parse ~p diff with
   | [] -> input
   | _::_::_ ->
     prerr_endline "Error: The diff contains several chunks,\n\
@@ -48,12 +48,17 @@ let () =
     prerr_endline usage;
     exit 0;
   end;
-  let input_path, diff_path, output_path = try
-      let input_path = Sys.argv.(1) in
-      let diff_path = Sys.argv.(2) in
-      let dash_o = Sys.argv.(3) in
-      let output_path = Sys.argv.(4) in
+  let p, input_path, diff_path, output_path = try
+      let p =
+        let arg = Sys.argv.(1) in
+        String.sub arg 2 (String.length arg - 2) |> int_of_string
+      in
+      let input_path = Sys.argv.(2) in
+      let diff_path = Sys.argv.(3) in
+      let dash_o = Sys.argv.(4) in
+      let output_path = Sys.argv.(5) in
       if dash_o <> "-o" then raise Exit;
+      p,
       input_path,
       diff_path,
       output_path
@@ -84,5 +89,5 @@ let () =
   in
   let input_data = get_data input_path in
   let diff_data = get_data diff_path in
-  let output_data = run ~input:input_data ~diff:diff_data in
+  let output_data = run ~p ~input:input_data ~diff:diff_data in
   write_data output_path ~data:output_data

test/crowbar_test.ml

@@ -136,7 +136,7 @@ let get_diffs (file1 : file) (file2 : file) : file =
 
 let check_Patch file1 file2 =
   let text_diff = string_of_file (get_diffs file1 file2) in
-  match Patch.parse text_diff with
+  match Patch.parse ~p:0 text_diff with
   | [] -> Crowbar.check_eq (string_of_file file1) (string_of_file file2)
   | _::_::_ -> Crowbar.fail "not a single diff!"
   | [diff] ->

test/test.ml

@@ -16,7 +16,7 @@ let patch_eq a b =
   List.length a.hunks = List.length b.hunks &&
   List.for_all (fun h -> List.exists (fun h' -> hunk_eq h h') b.hunks) a.hunks
 
-let test_t = Alcotest.testable (Patch.pp ~git:false) patch_eq
+let test_t = Alcotest.testable Patch.pp patch_eq
 
 let basic_files = [
   Some "foo\n" ;
@@ -295,7 +295,7 @@ foo
 ]
 
 let basic_parse diff exp () =
-  let diffs = Patch.parse diff in
+  let diffs = Patch.parse ~p:0 diff in
   Alcotest.(check (list test_t) __LOC__ exp diffs)
 
 let parse_diffs =
@@ -304,7 +304,7 @@ let parse_diffs =
     (List.combine basic_diffs basic_hunks)
 
 let basic_apply file diff exp () =
-  match Patch.parse diff with
+  match Patch.parse ~p:0 diff with
   | [ diff ] ->
     let res = Patch.patch file diff in
     Alcotest.(check (option string) __LOC__ exp res)
@@ -367,7 +367,7 @@ let multi_files = [ Some "bar" ; Some "baz" ; None ; Some "foobarbaz" ]
 let multi_exp = [ Some "foobar" ; None ; Some "baz" ; Some "foobar" ]
 
 let multi_apply () =
-  let diffs = Patch.parse multi_diff in
+  let diffs = Patch.parse ~p:0 multi_diff in
   Alcotest.(check int __LOC__ (List.length multi_files) (List.length diffs));
   Alcotest.(check int __LOC__ (List.length multi_exp) (List.length diffs));
   List.iter2 (fun diff (input, expected) ->
@@ -412,11 +412,11 @@ let read file =
 
 let opt_read file = try Some (read file) with Unix.Unix_error _ -> None
 
-let op_test = Alcotest.testable (Patch.pp_operation ~git:false) Patch.operation_eq
+let op_test = Alcotest.testable Patch.pp_operation Patch.operation_eq
 
 let parse_real_diff_header file hdr () =
   let data = read (file ^ ".diff") in
-  let diffs = Patch.parse data in
+  let diffs = Patch.parse ~p:0 data in
   Alcotest.(check int __LOC__ 1 (List.length diffs));
   Alcotest.check op_test __LOC__ hdr (List.hd diffs).Patch.operation
 
@@ -425,17 +425,17 @@ let parse_real_diff_headers =
       "parsing " ^ file ^ ".diff", `Quick, parse_real_diff_header file hdr)
     [ "first", Patch.Edit ("first.old", "first.new") ;
       "create1", Patch.Create "a/create1" ;
-      "git1", Patch.Create "git1.new" ;
+      "git1", Patch.Create "b/git1.new" ;
       "git2", Patch.Rename_only ("git2.old", "git2.new") ;
-      "git3", Patch.Edit ("git3.old", "git3.new") ;
-      "git4", Patch.Delete "git4.old"
+      "git3", Patch.Edit ("a/git3.old", "b/git3.new") ;
+      "git4", Patch.Delete "a/git4.old"
     ]
 
 let regression_test name () =
   let old = opt_read (name ^ ".old") in
   let diff = read (name ^ ".diff") in
   let exp = opt_read (name ^ ".new") in
-  match Patch.parse diff with
+  match Patch.parse ~p:0 diff with
   | [ diff ] ->
     let res = Patch.patch old diff in
     Alcotest.(check (option string) __LOC__ exp res)
@@ -807,7 +807,7 @@ let unified_diff_creation = [
 ]
 
 let operations exp diff () =
-  let ops = diff |> Patch.parse |> List.map (fun p -> p.Patch.operation) in
+  let ops = diff |> Patch.parse ~p:0 |> List.map (fun p -> p.Patch.operation) in
   Alcotest.(check (list op_test)) __LOC__ exp ops
 
 let unified_diff_spaces = {|\
@@ -832,7 +832,7 @@ index ef00db3..88adca3 100644
 |}
 
 let git_diff_spaces =
-  operations [Patch.Edit ("foo bar", "foo bar")] git_diff_spaces
+  operations [Patch.Edit ("a/foo bar", "b/foo bar")] git_diff_spaces
 
 let busybox_diff_spaces = {|\
 --- a/foo bar
@@ -867,7 +867,7 @@ index 88adca3..ef00db3 100644
 |}
 
 let git_diff_quotes =
-  operations [Patch.Edit ({|foo bar "baz"|}, {|"foo" bar baz|})] git_diff_quotes
+  operations [Patch.Edit ({|a/foo bar "baz"|}, {|b/"foo" bar baz|})] git_diff_quotes
 
 let busybox_diff_quotes = {|\
 --- foo bar "baz"
@@ -970,6 +970,47 @@ let filename_diffs =
     "unquoted filename with backslashes", `Quick, unquoted_filename;
   ]
 
+let operations ~p exp diff () =
+  let ops = diff |> Patch.parse ~p |> List.map (fun p -> p.Patch.operation) in
+  Alcotest.(check (list op_test)) __LOC__ exp ops
+
+let p1_p2 = {|\
+--- a.orig/a/test
++++ b.new/b/test
+@@ -0,0 +1 @@
++aaa
+|}
+
+let p1 = operations ~p:1 [Patch.Edit ("a/test", "b/test")] p1_p2
+let p2 = operations ~p:2 [Patch.Edit ("test", "test")] p1_p2
+
+let p1_adjacent_slashes = {|\
+--- a///some//dir////test
++++ b///some/dir/test
+@@ -0,0 +1 @@
++aaa
+|}
+
+let p1_adjacent_slashes = operations ~p:1 [Patch.Edit ("some/dir/test", "some/dir/test")] p1_adjacent_slashes
+
+let p0_p1_root = {|\
+--- /a/test
++++ /b/test
+@@ -0,0 +1 @@
++aaa
+|}
+
+let p0_root = operations ~p:0 [Patch.Edit ("/a/test", "/b/test")] p0_p1_root
+let p1_root = operations ~p:1 [Patch.Edit ("a/test", "b/test")] p0_p1_root
+
+let patch_p = [
+  "-p1", `Quick, p1;
+  "-p2", `Quick, p2;
+  "-p1 with adjacent slashes", `Quick, p1_adjacent_slashes;
+  "-p0 with root files", `Quick, p0_root;
+  "-p1 with root files", `Quick, p1_root;
+]
+
 let tests = [
   "parse", parse_diffs ;
   "apply", apply_diffs ;
@@ -979,6 +1020,7 @@ let tests = [
   "parse real diffs", parse_real_diff_headers ;
   "regression", regression_diffs ;
   "diff", unified_diff_creation ;
+  "patch -p", patch_p;
 ]
 
 let () =