patch-3.0.0/0000755000175000017500000000000015031511054014204 5ustar kit_ty_katekit_ty_katepatch-3.0.0/test/0000755000175000017500000000000015031511054015163 5ustar kit_ty_katekit_ty_katepatch-3.0.0/test/test.ml0000644000175000017500000011343115031511054016477 0ustar kit_ty_katekit_ty_kate let hunk_eq a b = let open Patch in a.mine_start = b.mine_start && a.mine_len = b.mine_len && a.their_start = b.their_start && a.their_len = b.their_len && List.length a.mine = List.length b.mine && List.length a.their = List.length b.their && List.for_all (fun x -> List.mem x b.mine) a.mine && List.for_all (fun x -> List.mem x b.their) a.their let patch_eq a b = let open Patch in operation_eq a.operation b.operation && 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 patch_eq let basic_files = [ Some "foo\n" ; Some {|foo bar baz boo foo bar baz boo |} ; Some {|foo bar baz boo foo bar bar boo foo bar baz |} ; Some {|foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo |} ; None ; Some "foo\n" ; Some "foo\n" ] let basic_diffs = let hdr = Printf.sprintf {|--- a%s2019-03-10 16:48:51.826103000 +0100 +++ b%s2019-03-10 16:48:54.373352000 +0100 |} "\t" "\t" in [ hdr ^ {|@@ -1 +1 @@ -foo +foobar |} ; hdr ^ {|@@ -2,7 +2,7 @@ bar baz boo -foo +foo2 bar baz boo |} ; hdr ^ {|@@ -1,5 +1,5 @@ foo -bar +bar2 baz boo foo @@ -8,4 +8,4 @@ boo foo bar -baz +baz3 |} ; hdr ^ {|@@ -1,6 +1,7 @@ foo foo foo +foo3 foo foo foo @@ -9,6 +10,7 @@ foo foo foo +foo5 foo foo foo @@ -31,6 +33,11 @@ foo foo foo +bar foo foo foo +foo +foo +foo +bar2 |} ; {|--- /dev/null +++ b @@ -0,0 +1 @@ +foo |} ; {|--- a +++ /dev/null @@ -1 +0,0 @@ -foo |} ; {|--- a +++ b @@ -1 +1,2 @@ foo +foo |} ] let basic_hunks = let open Patch in let hunk1 = [ { mine_start = 1 ; mine_len = 1 ; mine = ["foo"] ; their_start = 1 ; their_len = 1 ; their = ["foobar"] } ] in let diff = { operation = Edit ("a", "b") ; hunks = hunk1 ; mine_no_nl = false ; their_no_nl = false } in let hunk2 = [ { mine_start = 2 ; mine_len = 7 ; mine = [ "bar" ; "baz" ; "boo" ; "foo" ; "bar" ; "baz" ; "boo" ] ; their_start = 2 ; their_len = 7 ; their = [ "bar" ; "baz" ; "boo" ; "foo2" ; "bar" ; "baz" ; "boo" ] } ] in let hunk3 = [ { mine_start = 1 ; mine_len = 5 ; mine = [ "foo" ; "bar" ; "baz" ; "boo" ; "foo" ] ; their_start = 1 ; their_len = 5 ; their = [ "foo" ; "bar2" ; "baz" ; "boo" ; "foo" ] } ; { mine_start = 8 ; mine_len = 4 ; mine = [ "boo" ; "foo" ; "bar" ; "baz" ] ; their_start = 8 ; their_len = 4 ; their = [ "boo" ; "foo" ; "bar" ; "baz3" ] } ] in let hunk4 = [ { mine_start = 1 ; mine_len = 6 ; mine = [ "foo" ; "foo" ; "foo" ; "foo" ; "foo" ; "foo" ] ; their_start = 1 ; their_len = 7 ; their = [ "foo" ; "foo" ; "foo" ; "foo3" ; "foo" ; "foo" ; "foo" ] } ; { mine_start = 9 ; mine_len = 6 ; mine = [ "foo" ; "foo" ; "foo" ; "foo" ; "foo" ; "foo" ] ; their_start = 10 ; their_len = 7 ; their = [ "foo" ; "foo" ; "foo" ; "foo5" ; "foo" ; "foo" ; "foo" ] } ; { mine_start = 31 ; mine_len = 6 ; mine = [ "foo" ; "foo" ; "foo" ; "foo" ; "foo" ; "foo" ] ; their_start = 33 ; their_len = 11 ; their = [ "foo" ; "foo" ; "foo" ; "bar" ; "foo" ; "foo" ; "foo" ; "foo" ; "foo" ; "foo" ; "bar2" ] } ] in let hunk5= [ { mine_start = 0 ; mine_len = 0 ; mine = [] ; their_start = 1 ; their_len = 1 ; their = [ "foo" ] } ] in let diff5 = { diff with operation = Create "b" ; hunks = hunk5 } in let hunk6 = [ { mine_start = 1 ; mine_len = 1 ; mine = [ "foo" ] ; their_start = 0 ; their_len = 0 ; their = [ ] } ] in let diff6 = { diff with operation = Delete "a" ; hunks = hunk6 } in let hunk7 = [ { mine_start = 1 ; mine_len = 1 ; mine = [ "foo" ] ; their_start = 1 ; their_len = 2 ; their = [ "foo" ; "foo" ] } ] in let diff7 = { diff with operation = Edit ("a", "b") ; hunks = hunk7 } in List.map (fun d -> [ d ]) [ diff ; { diff with hunks = hunk2 } ; { diff with hunks = hunk3 } ; { diff with hunks = hunk4 } ; diff5 ; diff6 ; diff7 ; ] let basic_app = [ Some "foobar\n" ; Some {|foo bar baz boo foo2 bar baz boo |} ; Some {|foo bar2 baz boo foo bar bar boo foo bar baz3 |} ; Some {|foo foo foo foo3 foo foo foo foo foo foo foo foo foo5 foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo bar foo foo foo foo foo foo bar2 |} ; Some {|foo |} ; None ; Some {|foo foo |} ] let basic_parse diff exp () = let diffs = Patch.parse ~p:0 diff in Alcotest.(check (list test_t) __LOC__ exp diffs) let parse_diffs = List.mapi (fun idx (diff, exp) -> "basic" ^ string_of_int idx, `Quick, basic_parse diff exp) (List.combine basic_diffs basic_hunks) let basic_apply file diff exp () = match Patch.parse ~p:0 diff with | [ diff ] -> let res = Patch.patch ~cleanly:true file diff in Alcotest.(check (option string) __LOC__ exp res) | _ -> Alcotest.fail "expected one" let apply_diffs = List.mapi (fun idx (exp, (data, diff)) -> "basic" ^ string_of_int idx, `Quick, basic_apply data diff exp) (List.combine basic_app (List.combine basic_files basic_diffs)) (* a diff with multiple files to patch, with each of the four kinds: rename, delete, create, edit *) let multi_diff = {| --- foo +++ bar @@ -1 +1 @@ -bar +foobar --- foobar +++ /dev/null @@ -1 +0,0 @@ -baz --- /dev/null +++ baz @@ -0,0 +1 @@ +baz \ No newline at end of file --- foobarbaz +++ foobarbaz @@ -1 +1 @@ -foobarbaz +foobar |} let multi_hunks = let open Patch in let hunk1 = [ { mine_start = 1 ; mine_len = 1 ; mine = ["bar"] ; their_start = 1 ; their_len = 1 ; their = ["foobar"] } ] in let diff1 = { operation = Edit ("foo", "bar") ; hunks = hunk1 ; mine_no_nl = false ; their_no_nl = false } in let hunk2 = [ { mine_start = 1 ; mine_len = 1 ; mine = [ "baz" ] ; their_start = 0 ; their_len = 0 ; their = [] } ] in let diff2 = { operation = Delete "foobar" ; hunks = hunk2 ; mine_no_nl = false ; their_no_nl = false } in let hunk3 = [ { mine_start = 0 ; mine_len = 0 ; mine = [ ] ; their_start = 1 ; their_len = 1 ; their = [ "baz" ] } ] in let diff3 = { operation = Create "baz" ; hunks = hunk3 ; mine_no_nl = false ; their_no_nl = true } in let hunk4 = [ { mine_start = 1 ; mine_len = 1 ; mine = [ "foobarbaz" ] ; their_start = 1 ; their_len = 1 ; their = [ "foobar" ] } ] in let diff4 = { operation = Edit ("foobarbaz", "foobarbaz") ; hunks = hunk4 ; mine_no_nl = false ; their_no_nl = false } in [ diff1 ; diff2 ; diff3 ; diff4 ] 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 ~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) -> let res = Patch.patch ~cleanly:true input diff in Alcotest.(check (option string) __LOC__ expected res)) diffs (List.combine multi_files multi_exp) let multi_diffs = [ "multi parse", `Quick, basic_parse multi_diff multi_hunks ; "multi apply", `Quick, multi_apply ; ] let regression_diff, regression_hunks = let open Patch in {| --- a 2024-03-22 20:38:14.411917871 +0000 +++ b 2024-03-22 20:04:53.409348792 +0000 @@ -1 +1 @@ --- /dev/null +aaa |}, [ { operation = Edit ("a", "b"); hunks = [ { mine_start = 1; mine_len = 1; mine = ["-- /dev/null"]; their_start = 1; their_len = 1; their = ["aaa"]} ]; mine_no_nl = false; their_no_nl = false} ] let basic_regression_diffs = [ "basic regression parse", `Quick, basic_parse regression_diff regression_hunks ; ] let data = "data/" let read file = let filename = data ^ file in let size = (Unix.stat filename).st_size in let buf = Bytes.create size in let fd = Unix.openfile filename [ Unix.O_RDONLY ] 0 in let res = let rec loop i = function | 0 -> i | size -> let nread = Unix.read fd buf i size in loop (i + nread) (size - nread) in loop 0 size in assert (res = size) ; Unix.close fd ; Bytes.unsafe_to_string buf let opt_read file = try Some (read file) with Unix.Unix_error _ -> None 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 ~p:0 data in Alcotest.(check int __LOC__ 1 (List.length diffs)); Alcotest.check op_test __LOC__ hdr (List.hd diffs).Patch.operation let parse_real_diff_headers = List.map (fun (file, hdr) -> "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 "b/git1.new" ; "git2", Patch.Git_ext ("a/git2.old", "b/git2.new", Patch.Rename_only ("git2.old", "git2.new")) ; "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 ~p:0 diff with | [ diff ] -> let res = Patch.patch ~cleanly:true old diff in Alcotest.(check (option string) __LOC__ exp res) | ds -> Alcotest.fail ("expected one, found " ^ string_of_int (List.length ds)) module S = Set.Make(String) let drop_ext str = try let idx = String.rindex str '.' in String.sub str 0 idx with | Not_found -> str let regression_diffs = let collect_dir dir = let open Unix in let dh = opendir dir in let next () = try Some (readdir dh) with End_of_file -> None in let rec doone acc = function | Some "." | Some ".." -> doone acc (next ()) | Some s when not (Sys.is_directory (Filename.concat dir s)) -> doone (s :: acc) (next ()) | Some _ -> doone acc (next ()) | None -> acc in let res = doone [] (next ()) in closedir dh ; res in let files = collect_dir data in let tests = List.fold_left (fun acc file -> S.add (drop_ext file) acc) S.empty files in List.map (fun test -> "regression " ^ test, `Quick, regression_test test) (S.elements tests) let diff_tests_mine_unavailable_gen ~their_no_nl = let a = None and b = {|aaa bbb ccc ddd eee|}^(if their_no_nl then "" else "\n") in let diff = Patch.diff a (Some ("b", b)) in let hunk = { Patch.operation = Create "b"; hunks = [ { mine_start = 0; mine_len = 0; mine = []; their_start = 1; their_len = 5; their = ["aaa"; "bbb"; "ccc"; "ddd"; "eee"]} ]; mine_no_nl = false; their_no_nl} in diff, Some hunk let diff_tests_mine_unavailable_their_no_nl, diff_tests_hunk_mine_unavailable_their_no_nl = diff_tests_mine_unavailable_gen ~their_no_nl:true let diff_tests_mine_unavailable_none_no_nl, diff_tests_hunk_mine_unavailable_none_no_nl = diff_tests_mine_unavailable_gen ~their_no_nl:false let diff_tests_their_unavailable_gen ~mine_no_nl = let a = {|aaa bbb ccc ddd eee|}^(if mine_no_nl then "" else "\n") and b = None in let diff = Patch.diff (Some ("a", a)) b in let hunk = { Patch.operation = Delete "a"; hunks = [ { mine_start = 1; mine_len = 5; mine = ["aaa"; "bbb"; "ccc"; "ddd"; "eee"]; their_start = 0; their_len = 0; their = []} ]; mine_no_nl; their_no_nl = false} in diff, Some hunk let diff_tests_their_unavailable_mine_no_nl, diff_tests_hunk_their_unavailable_mine_no_nl = diff_tests_their_unavailable_gen ~mine_no_nl:true let diff_tests_their_unavailable_none_no_nl, diff_tests_hunk_their_unavailable_none_no_nl = diff_tests_their_unavailable_gen ~mine_no_nl:false let diff_tests_empty_gen ~mine_no_nl ~their_no_nl = let a = if mine_no_nl then "" else "\n" and b = if their_no_nl then "" else "\n" in let diff = Patch.diff (Some ("a", a)) (Some ("b", b)) in let hunk = if (mine_no_nl && their_no_nl) || (not mine_no_nl && not their_no_nl) then None else let mine_len, mine = if mine_no_nl then 0, [] else 1, [""] in let their_len, their = if their_no_nl then 0, [] else 1, [""] in Some { Patch.operation = Edit ("a", "b"); hunks = [ { mine_start = if mine_no_nl then 0 else 1; mine_len; mine; their_start = if their_no_nl then 0 else 1; their_len; their} ]; mine_no_nl = false; their_no_nl = false} in diff, hunk let diff_tests_empty_both_no_nl, diff_tests_hunk_empty_both_no_nl = diff_tests_empty_gen ~mine_no_nl:true ~their_no_nl:true let diff_tests_empty_mine_no_nl, diff_tests_hunk_empty_mine_no_nl = diff_tests_empty_gen ~mine_no_nl:true ~their_no_nl:false let diff_tests_empty_their_no_nl, diff_tests_hunk_empty_their_no_nl = diff_tests_empty_gen ~mine_no_nl:false ~their_no_nl:true let diff_tests_empty_none_no_nl, diff_tests_hunk_empty_none_no_nl = diff_tests_empty_gen ~mine_no_nl:false ~their_no_nl:false let diff_tests_no_diff_gen ~mine_no_nl ~their_no_nl = let a = {|aaa bbb ccc ddd eee|}^(if mine_no_nl then "" else "\n") and b = {|aaa bbb ccc ddd eee|}^(if their_no_nl then "" else "\n") in let diff = Patch.diff (Some ("a", a)) (Some ("b", b)) in let hunk = if (mine_no_nl && their_no_nl) || (not mine_no_nl && not their_no_nl) then None else Some { Patch.operation = Edit ("a", "b"); hunks = [ { mine_start = 5; mine_len = 1; mine = ["eee"]; their_start = 5; their_len = 1; their = ["eee"]} ]; mine_no_nl; their_no_nl} in diff, hunk let diff_tests_no_diff_both_no_nl, diff_tests_hunk_no_diff_both_no_nl = diff_tests_no_diff_gen ~mine_no_nl:true ~their_no_nl:true let diff_tests_no_diff_mine_no_nl, diff_tests_hunk_no_diff_mine_no_nl = diff_tests_no_diff_gen ~mine_no_nl:true ~their_no_nl:false let diff_tests_no_diff_their_no_nl, diff_tests_hunk_no_diff_their_no_nl = diff_tests_no_diff_gen ~mine_no_nl:false ~their_no_nl:true let diff_tests_no_diff_none_no_nl, diff_tests_hunk_no_diff_none_no_nl = diff_tests_no_diff_gen ~mine_no_nl:false ~their_no_nl:false let diff_tests_middle_same_size_gen ~mine_no_nl ~their_no_nl = let a = {|aaa bbb ccc ddd eee|}^(if mine_no_nl then "" else "\n") and b = {|aaa bbb test1 test2 eee|}^(if their_no_nl then "" else "\n") in let diff = Patch.diff (Some ("a", a)) (Some ("b", b)) in let hunk = { Patch.operation = Edit ("a", "b"); hunks = [ { mine_start = 3; mine_len = 3; mine = ["ccc"; "ddd"; "eee"]; their_start = 3; their_len = 3; their = ["test1"; "test2"; "eee"]} ]; mine_no_nl; their_no_nl} in diff, Some hunk let diff_tests_middle_same_size_both_no_nl, diff_tests_hunk_middle_same_size_both_no_nl = diff_tests_middle_same_size_gen ~mine_no_nl:true ~their_no_nl:true let diff_tests_middle_same_size_mine_no_nl, diff_tests_hunk_middle_same_size_mine_no_nl = diff_tests_middle_same_size_gen ~mine_no_nl:true ~their_no_nl:false let diff_tests_middle_same_size_their_no_nl, diff_tests_hunk_middle_same_size_their_no_nl = diff_tests_middle_same_size_gen ~mine_no_nl:false ~their_no_nl:true let diff_tests_middle_same_size_none_no_nl, diff_tests_hunk_middle_same_size_none_no_nl = diff_tests_middle_same_size_gen ~mine_no_nl:false ~their_no_nl:false let diff_tests_middle_diff_size_gen ~mine_no_nl ~their_no_nl = let a = {|aaa bbb ccc ddd eee|}^(if mine_no_nl then "" else "\n") and b = {|aaa bbb test1 eee|}^(if their_no_nl then "" else "\n") in let diff = Patch.diff (Some ("a", a)) (Some ("b", b)) in let hunk = { Patch.operation = Edit ("a", "b"); hunks = [ { mine_start = 3; mine_len = 3; mine = ["ccc"; "ddd"; "eee"]; their_start = 3; their_len = 2; their = ["test1"; "eee"]} ]; mine_no_nl; their_no_nl} in diff, Some hunk let diff_tests_middle_diff_size_both_no_nl, diff_tests_hunk_middle_diff_size_both_no_nl = diff_tests_middle_diff_size_gen ~mine_no_nl:true ~their_no_nl:true let diff_tests_middle_diff_size_mine_no_nl, diff_tests_hunk_middle_diff_size_mine_no_nl = diff_tests_middle_diff_size_gen ~mine_no_nl:true ~their_no_nl:false let diff_tests_middle_diff_size_their_no_nl, diff_tests_hunk_middle_diff_size_their_no_nl = diff_tests_middle_diff_size_gen ~mine_no_nl:false ~their_no_nl:true let diff_tests_middle_diff_size_none_no_nl, diff_tests_hunk_middle_diff_size_none_no_nl = diff_tests_middle_diff_size_gen ~mine_no_nl:false ~their_no_nl:false let diff_tests_beginning_same_size_gen ~mine_no_nl ~their_no_nl = let a = {|aaa bbb ccc ddd eee|}^(if mine_no_nl then "" else "\n") and b = {|test1 bbb ccc ddd eee|}^(if their_no_nl then "" else "\n") in let diff = Patch.diff (Some ("a", a)) (Some ("b", b)) in let hunk = { Patch.operation = Edit ("a", "b"); hunks = [ { mine_start = 1; mine_len = 5; mine = ["aaa"; "bbb"; "ccc"; "ddd"; "eee"]; their_start = 1; their_len = 5; their = ["test1"; "bbb"; "ccc"; "ddd"; "eee"]} ]; mine_no_nl; their_no_nl} in diff, Some hunk let diff_tests_beginning_same_size_both_no_nl, diff_tests_hunk_beginning_same_size_both_no_nl = diff_tests_beginning_same_size_gen ~mine_no_nl:true ~their_no_nl:true let diff_tests_beginning_same_size_mine_no_nl, diff_tests_hunk_beginning_same_size_mine_no_nl = diff_tests_beginning_same_size_gen ~mine_no_nl:true ~their_no_nl:false let diff_tests_beginning_same_size_their_no_nl, diff_tests_hunk_beginning_same_size_their_no_nl = diff_tests_beginning_same_size_gen ~mine_no_nl:false ~their_no_nl:true let diff_tests_beginning_same_size_none_no_nl, diff_tests_hunk_beginning_same_size_none_no_nl = diff_tests_beginning_same_size_gen ~mine_no_nl:false ~their_no_nl:false let diff_tests_beginning_diff_size_gen ~mine_no_nl ~their_no_nl = let a = {|aaa bbb ccc ddd eee|}^(if mine_no_nl then "" else "\n") and b = {|test1 ccc ddd eee|}^(if their_no_nl then "" else "\n") in let diff = Patch.diff (Some ("a", a)) (Some ("b", b)) in let hunk = { Patch.operation = Edit ("a", "b"); hunks = [ { mine_start = 1; mine_len = 5; mine = ["aaa"; "bbb"; "ccc"; "ddd"; "eee"]; their_start = 1; their_len = 4; their = ["test1"; "ccc"; "ddd"; "eee"]} ]; mine_no_nl; their_no_nl} in diff, Some hunk let diff_tests_beginning_diff_size_both_no_nl, diff_tests_hunk_beginning_diff_size_both_no_nl = diff_tests_beginning_diff_size_gen ~mine_no_nl:true ~their_no_nl:true let diff_tests_beginning_diff_size_mine_no_nl, diff_tests_hunk_beginning_diff_size_mine_no_nl = diff_tests_beginning_diff_size_gen ~mine_no_nl:true ~their_no_nl:false let diff_tests_beginning_diff_size_their_no_nl, diff_tests_hunk_beginning_diff_size_their_no_nl = diff_tests_beginning_diff_size_gen ~mine_no_nl:false ~their_no_nl:true let diff_tests_beginning_diff_size_none_no_nl, diff_tests_hunk_beginning_diff_size_none_no_nl = diff_tests_beginning_diff_size_gen ~mine_no_nl:false ~their_no_nl:false let diff_tests_end_same_size_gen ~mine_no_nl ~their_no_nl = let a = {|aaa bbb ccc ddd eee|}^(if mine_no_nl then "" else "\n") and b = {|aaa bbb ccc ddd test1|}^(if their_no_nl then "" else "\n") in let diff = Patch.diff (Some ("a", a)) (Some ("b", b)) in let hunk = { Patch.operation = Edit ("a", "b"); hunks = [ { mine_start = 5; mine_len = 1; mine = ["eee"]; their_start = 5; their_len = 1; their = ["test1"]} ]; mine_no_nl; their_no_nl} in diff, Some hunk let diff_tests_end_same_size_both_no_nl, diff_tests_hunk_end_same_size_both_no_nl = diff_tests_end_same_size_gen ~mine_no_nl:true ~their_no_nl:true let diff_tests_end_same_size_mine_no_nl, diff_tests_hunk_end_same_size_mine_no_nl = diff_tests_end_same_size_gen ~mine_no_nl:true ~their_no_nl:false let diff_tests_end_same_size_their_no_nl, diff_tests_hunk_end_same_size_their_no_nl = diff_tests_end_same_size_gen ~mine_no_nl:false ~their_no_nl:true let diff_tests_end_same_size_none_no_nl, diff_tests_hunk_end_same_size_none_no_nl = diff_tests_end_same_size_gen ~mine_no_nl:false ~their_no_nl:false let diff_tests_end_diff_size_gen ~mine_no_nl ~their_no_nl = let a = {|aaa bbb ccc ddd eee|}^(if mine_no_nl then "" else "\n") and b = {|aaa bbb ccc test1|}^(if their_no_nl then "" else "\n") in let diff = Patch.diff (Some ("a", a)) (Some ("b", b)) in let hunk = { Patch.operation = Edit ("a", "b"); hunks = [ { mine_start = 4; mine_len = 2; mine = ["ddd"; "eee"]; their_start = 4; their_len = 1; their = ["test1"]} ]; mine_no_nl; their_no_nl} in diff, Some hunk let diff_tests_end_diff_size_both_no_nl, diff_tests_hunk_end_diff_size_both_no_nl = diff_tests_end_diff_size_gen ~mine_no_nl:true ~their_no_nl:true let diff_tests_end_diff_size_mine_no_nl, diff_tests_hunk_end_diff_size_mine_no_nl = diff_tests_end_diff_size_gen ~mine_no_nl:true ~their_no_nl:false let diff_tests_end_diff_size_their_no_nl, diff_tests_hunk_end_diff_size_their_no_nl = diff_tests_end_diff_size_gen ~mine_no_nl:false ~their_no_nl:true let diff_tests_end_diff_size_none_no_nl, diff_tests_hunk_end_diff_size_none_no_nl = diff_tests_end_diff_size_gen ~mine_no_nl:false ~their_no_nl:false let check_diff diff1 diff2 () = Alcotest.(check (option test_t) __LOC__ diff1 diff2) let unified_diff_creation = [ "mine unavailable, their no_nl", `Quick, check_diff diff_tests_mine_unavailable_their_no_nl diff_tests_hunk_mine_unavailable_their_no_nl ; "mine unavailable, none no_nl", `Quick, check_diff diff_tests_mine_unavailable_none_no_nl diff_tests_hunk_mine_unavailable_none_no_nl; "their unavailable, mine no_nl", `Quick, check_diff diff_tests_their_unavailable_mine_no_nl diff_tests_hunk_their_unavailable_mine_no_nl ; "their unavailable, none no_nl", `Quick, check_diff diff_tests_their_unavailable_none_no_nl diff_tests_hunk_their_unavailable_none_no_nl ; "empty, both no_nl", `Quick, check_diff diff_tests_empty_both_no_nl diff_tests_hunk_empty_both_no_nl; "empty, mine no_nl", `Quick, check_diff diff_tests_empty_mine_no_nl diff_tests_hunk_empty_mine_no_nl; "empty, their no_nl", `Quick, check_diff diff_tests_empty_their_no_nl diff_tests_hunk_empty_their_no_nl; "empty, none no_nl", `Quick, check_diff diff_tests_empty_none_no_nl diff_tests_hunk_empty_none_no_nl; "no diff, both no_nl", `Quick, check_diff diff_tests_no_diff_both_no_nl diff_tests_hunk_no_diff_both_no_nl ; "no diff, mine no_nl", `Quick, check_diff diff_tests_no_diff_mine_no_nl diff_tests_hunk_no_diff_mine_no_nl ; "no diff, their no_nl", `Quick, check_diff diff_tests_no_diff_their_no_nl diff_tests_hunk_no_diff_their_no_nl ; "no diff, none no_nl", `Quick, check_diff diff_tests_no_diff_none_no_nl diff_tests_hunk_no_diff_none_no_nl ; "middle, same size, both no_nl", `Quick, check_diff diff_tests_middle_same_size_both_no_nl diff_tests_hunk_middle_same_size_both_no_nl ; "middle, same size, mine no_nl", `Quick, check_diff diff_tests_middle_same_size_mine_no_nl diff_tests_hunk_middle_same_size_mine_no_nl; "middle, same size, their no_nl", `Quick, check_diff diff_tests_middle_same_size_their_no_nl diff_tests_hunk_middle_same_size_their_no_nl ; "middle, same size, none no_nl", `Quick, check_diff diff_tests_middle_same_size_none_no_nl diff_tests_hunk_middle_same_size_none_no_nl ; "middle, diff size, both no_nl", `Quick, check_diff diff_tests_middle_diff_size_both_no_nl diff_tests_hunk_middle_diff_size_both_no_nl ; "middle, diff size, mine no_nl", `Quick, check_diff diff_tests_middle_diff_size_mine_no_nl diff_tests_hunk_middle_diff_size_mine_no_nl ; "middle, diff size, their no_nl", `Quick, check_diff diff_tests_middle_diff_size_their_no_nl diff_tests_hunk_middle_diff_size_their_no_nl ; "middle, diff size, none no_nl", `Quick, check_diff diff_tests_middle_diff_size_none_no_nl diff_tests_hunk_middle_diff_size_none_no_nl ; "beginning, same size, both no_nl", `Quick, check_diff diff_tests_beginning_same_size_both_no_nl diff_tests_hunk_beginning_same_size_both_no_nl ; "beginning, same size, mine no_nl", `Quick, check_diff diff_tests_beginning_same_size_mine_no_nl diff_tests_hunk_beginning_same_size_mine_no_nl ; "beginning, same size, their no_nl", `Quick, check_diff diff_tests_beginning_same_size_their_no_nl diff_tests_hunk_beginning_same_size_their_no_nl ; "beginning, same size, none no_nl", `Quick, check_diff diff_tests_beginning_same_size_none_no_nl diff_tests_hunk_beginning_same_size_none_no_nl ; "beginning, diff size, both no_nl", `Quick, check_diff diff_tests_beginning_diff_size_both_no_nl diff_tests_hunk_beginning_diff_size_both_no_nl ; "beginning, diff size, mine no_nl", `Quick, check_diff diff_tests_beginning_diff_size_mine_no_nl diff_tests_hunk_beginning_diff_size_mine_no_nl ; "beginning, diff size, their no_nl", `Quick, check_diff diff_tests_beginning_diff_size_their_no_nl diff_tests_hunk_beginning_diff_size_their_no_nl ; "beginning, diff size, none no_nl", `Quick, check_diff diff_tests_beginning_diff_size_none_no_nl diff_tests_hunk_beginning_diff_size_none_no_nl ; "end, same size, both no_nl", `Quick, check_diff diff_tests_end_same_size_both_no_nl diff_tests_hunk_end_same_size_both_no_nl ; "end, same size, mine no_nl", `Quick, check_diff diff_tests_end_same_size_mine_no_nl diff_tests_hunk_end_same_size_mine_no_nl ; "end, same size, their no_nl", `Quick, check_diff diff_tests_end_same_size_their_no_nl diff_tests_hunk_end_same_size_their_no_nl ; "end, same size, none no_nl", `Quick, check_diff diff_tests_end_same_size_none_no_nl diff_tests_hunk_end_same_size_none_no_nl ; "end, diff size, both no_nl", `Quick, check_diff diff_tests_end_diff_size_both_no_nl diff_tests_hunk_end_diff_size_both_no_nl ; "end, diff size, mine no_nl", `Quick, check_diff diff_tests_end_diff_size_mine_no_nl diff_tests_hunk_end_diff_size_mine_no_nl ; "end, diff size, their no_nl", `Quick, check_diff diff_tests_end_diff_size_their_no_nl diff_tests_hunk_end_diff_size_their_no_nl ; "end, diff size, none no_nl", `Quick, check_diff diff_tests_end_diff_size_none_no_nl diff_tests_hunk_end_diff_size_none_no_nl ; ] let operations exp diff () = 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 = {|\ --- "a/foo bar" 2024-09-04 10:56:24.139293679 +0200 +++ "b/foo bar" 2024-09-04 10:56:12.519195763 +0200 @@ -1 +1 @@ -This is wrong. +This is right. |} let unified_diff_spaces = operations [Patch.Edit ("a/foo bar", "b/foo bar")] unified_diff_spaces let git_diff_spaces = {|\ diff --git a/foo bar b/foo bar index ef00db3..88adca3 100644 --- a/foo bar|}^"\t"^{| +++ b/foo bar|}^"\t"^{| @@ -1 +1 @@ -This is wrong. +This is right. |} let git_diff_spaces = operations [Patch.Edit ("a/foo bar", "b/foo bar")] git_diff_spaces let busybox_diff_spaces = {|\ --- a/foo bar +++ b/foo bar @@ -1 +1 @@ -This is wrong. +This is right. |} let busybox_diff_spaces = operations [Patch.Edit ("a/foo", "b/foo")] busybox_diff_spaces let unified_diff_quotes = {|\ --- "foo bar \"baz\"" 2024-09-27 11:09:48.325541553 +0200 +++ "\"foo\" bar baz" 2024-09-27 11:06:42.612922437 +0200 @@ -1 +1 @@ -This is right. +This is wrong. |} let unified_diff_quotes = operations [Patch.Edit ({|foo bar "baz"|}, {|"foo" bar baz|})] unified_diff_quotes let git_diff_quotes = {|\ diff --git "a/foo bar \"baz\"" "b/\"foo\" bar baz" index 88adca3..ef00db3 100644 --- "a/foo bar \"baz\"" +++ "b/\"foo\" bar baz" @@ -1 +1 @@ -This is right. +This is wrong. |} let git_diff_quotes = operations [Patch.Edit ({|a/foo bar "baz"|}, {|b/"foo" bar baz|})] git_diff_quotes let busybox_diff_quotes = {|\ --- foo bar "baz" +++ "foo" bar baz @@ -1 +1 @@ -This is right. +This is wrong. |} let busybox_diff_quotes = operations [Patch.Edit ({|foo|}, {|foo|})] busybox_diff_quotes let dev_null_like = {|\ --- /dev/null_but_actually_not +++ b @@ -0,0 +1 @@ +foo |} let dev_null_like = operations [Patch.Edit ("/dev/null_but_actually_not", "b")] dev_null_like let macos_diff_N_deletion = {|\ diff -ruaN a/test b/test --- a/test 2024-03-21 11:29:11 +++ b/test 1970-01-01 01:00:00 @@ -1 +0,0 @@ -aaa |} let macos_diff_N_deletion = operations [Patch.Delete "a/test"] macos_diff_N_deletion let openbsd_diff_N_deletion = {|\ diff -ruaN a/test b/test --- a/test Thu Mar 21 12:34:45 2024 +++ b/test Thu Jan 1 01:00:00 1970 @@ -1 +0,0 @@ -aaa |} let openbsd_diff_N_deletion = operations [Patch.Delete "a/test"] openbsd_diff_N_deletion let gnu_diff_N_deletion = {|\ diff -ruaN a/test b/test --- a/test 2024-03-21 11:35:38.363194916 +0000 +++ b/test 1970-01-01 01:00:00.000000000 +0100 @@ -1 +0,0 @@ -aaa |} let gnu_diff_N_deletion = operations [Patch.Delete "a/test"] gnu_diff_N_deletion let busybox_diff_N_deletion = {|\ --- a/test +++ /dev/null @@ -1 +0,0 @@ -aaa |} let busybox_diff_N_deletion = operations [Patch.Delete "a/test"] busybox_diff_N_deletion let quoted_filename = {|\ --- /dev/null +++ "\a\b\f\n\r\t\v\\\"\001\177\046" @@ -0,0 +1 @@ +aaa |} let quoted_filename = operations [Patch.Create "\007\b\012\n\r\t\011\\\"\001\127&"] quoted_filename let unquoted_filename = {|\ --- /dev/null +++ \a\b\f\n\r\t\v\\\"\001\177\046 @@ -0,0 +1 @@ +aaa |} let unquoted_filename = operations [Patch.Create {|\a\b\f\n\r\t\v\\\"\001\177\046|}] unquoted_filename let filename_diffs = [ "unified diff with spaces", `Quick, unified_diff_spaces; "git diff with spaces", `Quick, git_diff_spaces; "busybox diff with spaces", `Quick, busybox_diff_spaces; "unified diff with quotes", `Quick, unified_diff_quotes; "git diff with quotes", `Quick, git_diff_quotes; "busybox diff with quotes", `Quick, busybox_diff_quotes; "file that looks like /dev/null", `Quick, dev_null_like; "diff -uN with file deletion on macOS", `Quick, macos_diff_N_deletion; "diff -uN with file deletion on OpenBSD", `Quick, openbsd_diff_N_deletion; "diff -uN with file deletion with GNU diff", `Quick, gnu_diff_N_deletion; "diff -uN with file deletion with Busybox", `Quick, busybox_diff_N_deletion; "heavily quoted filename", `Quick, quoted_filename; "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 pp_output_test = Alcotest.testable Format.pp_print_string String.equal let operations exp str () = let exp = Format.asprintf "%a" Patch.pp_operation exp in Alcotest.(check pp_output_test) __LOC__ str exp let plain_filename = {|--- a/test +++ b/test |} let plain_filename = operations (Patch.Edit ("a/test", "b/test")) plain_filename let filename_with_spaces = {|--- "a/one space" +++ "b/with two spaces" |} let filename_with_spaces = operations (Patch.Edit ("a/one space", "b/with two spaces")) filename_with_spaces let filename_with_special_chars = {|--- "\a\b\f\n\r\t\v some name \\\"\001\177&" +++ /dev/null |} let filename_with_special_chars = operations (Patch.Delete "\007\b\012\n\r\t\011 some name \\\"\001\127&") filename_with_special_chars let pp_filenames = [ "plain", `Quick, plain_filename; "with spaces", `Quick, filename_with_spaces; "with special characters", `Quick, filename_with_special_chars; ] let big_file = lazy (opt_read "./external/2025-01-before-archiving-phase1_999bff3ed88d26f76ff7eaddbfa7af49ed4737dc.diff") let expected = lazy (opt_read "./external/2025-01-before-archiving-phase1_999bff3ed88d26f76ff7eaddbfa7af49ed4737dc.expected") let support_string_length_above_20MB = Sys.max_string_length > 20_000_000 let parse_big () = if support_string_length_above_20MB then match Lazy.force big_file with | Some big_file -> let patch = Patch.parse ~p:1 big_file in Alcotest.(check int) __LOC__ 13_915 (List.length patch) | None -> Alcotest.skip () else Alcotest.skip () let print_big () = if support_string_length_above_20MB then match Lazy.force big_file, Lazy.force expected with | Some big_file, Some expected -> let patch = Patch.parse ~p:0 big_file in let actual = Format.asprintf "%a" Patch.pp_list patch in Alcotest.(check string) __LOC__ expected actual | None, _ | _, None -> Alcotest.skip () else Alcotest.skip () let parse_own () = if support_string_length_above_20MB then match Lazy.force expected with | Some expected -> let patch = Patch.parse ~p:0 expected in let actual = Format.asprintf "%a" Patch.pp_list patch in Alcotest.(check string) __LOC__ expected actual | None -> Alcotest.skip () else Alcotest.skip () let one_mil_old = lazy (opt_read "./external/1_000_000-old.txt") let one_mil_new = lazy (opt_read "./external/1_000_000-new.txt") let one_mil_diff = lazy (opt_read "./external/1_000_000.diff") let one_mil_print () = match Lazy.force one_mil_old, Lazy.force one_mil_new, Lazy.force one_mil_diff with | Some one_mil_old, Some one_mil_new, Some expected -> let patch = Patch.diff (Some ("1_000_000-old.txt", one_mil_old)) (Some ("1_000_000-new.txt", one_mil_new)) in let actual = Format.asprintf "%a" Patch.pp (Option.get patch) in Alcotest.(check string) __LOC__ expected actual | None, _, _ | _, None, _ | _, _, None -> Alcotest.skip () let one_mil_apply () = match Lazy.force one_mil_old, Lazy.force one_mil_new, Lazy.force one_mil_diff with | Some one_mil_old, Some expected, Some diff -> let patch = Patch.parse ~p:0 diff in let actual = Patch.patch ~cleanly:true (Some one_mil_old) (List.hd patch) in Alcotest.(check string) __LOC__ expected (Option.get actual) | None, _, _ | _, None, _ | _, _, None -> Alcotest.skip () let big_diff = [ "parse", `Quick, parse_big; "print", `Quick, print_big; "parse own", `Quick, parse_own; "1_000_000 print", `Quick, one_mil_print; "1_000_000 apply", `Quick, one_mil_apply; ] let print_diff_mine_empty_their_no_nl () = let a = {||} in let b = {|aaa bbb ccc|} in let expected = {|--- a +++ b @@ -0,0 +1,3 @@ +aaa +bbb +ccc \ No newline at end of file |} in let actual = Format.asprintf "%a" Patch.pp (Option.get (Patch.diff (Some ("a", a)) (Some ("b", b)))) in Alcotest.(check string) __LOC__ expected actual let print_diff_mine_empty_their_nl () = let a = {||} in let b = {|aaa bbb ccc |} in let expected = {|--- a +++ b @@ -0,0 +1,3 @@ +aaa +bbb +ccc |} in let actual = Format.asprintf "%a" Patch.pp (Option.get (Patch.diff (Some ("a", a)) (Some ("b", b)))) in Alcotest.(check string) __LOC__ expected actual let print_diff_mine_no_nl_their_empty () = let a = {|aaa bbb|} in let b = {||} in let expected = {|--- a +++ b @@ -1,2 +0,0 @@ -aaa -bbb \ No newline at end of file |} in let actual = Format.asprintf "%a" Patch.pp (Option.get (Patch.diff (Some ("a", a)) (Some ("b", b)))) in Alcotest.(check string) __LOC__ expected actual let print_diff_mine_nl_their_empty () = let a = {|aaa bbb |} in let b = {||} in let expected = {|--- a +++ b @@ -1,2 +0,0 @@ -aaa -bbb |} in let actual = Format.asprintf "%a" Patch.pp (Option.get (Patch.diff (Some ("a", a)) (Some ("b", b)))) in Alcotest.(check string) __LOC__ expected actual let print_diff_mine_no_nl_their_no_nl () = let a = {|aaa bbb|} in let b = {|aaa bbb ccc|} in let expected = {|--- a +++ b @@ -2,1 +2,2 @@ -bbb \ No newline at end of file +bbb +ccc \ No newline at end of file |} in let actual = Format.asprintf "%a" Patch.pp (Option.get (Patch.diff (Some ("a", a)) (Some ("b", b)))) in Alcotest.(check string) __LOC__ expected actual let print_diff_mine_no_nl_their_nl () = let a = {|aaa bbb|} in let b = {|aaa bbb ccc |} in let expected = {|--- a +++ b @@ -2,1 +2,2 @@ -bbb \ No newline at end of file +bbb +ccc |} in let actual = Format.asprintf "%a" Patch.pp (Option.get (Patch.diff (Some ("a", a)) (Some ("b", b)))) in Alcotest.(check string) __LOC__ expected actual let print_diff_mine_nl_their_no_nl () = let a = {|aaa bbb |} in let b = {|aaa bbb ccc|} in let expected = {|--- a +++ b @@ -3,0 +3,1 @@ +ccc \ No newline at end of file |} in let actual = Format.asprintf "%a" Patch.pp (Option.get (Patch.diff (Some ("a", a)) (Some ("b", b)))) in Alcotest.(check string) __LOC__ expected actual let print_diff_mine_nl_their_nl () = let a = {|aaa bbb |} in let b = {|aaa bbb ccc |} in let expected = {|--- a +++ b @@ -3,0 +3,1 @@ +ccc |} in let actual = Format.asprintf "%a" Patch.pp (Option.get (Patch.diff (Some ("a", a)) (Some ("b", b)))) in Alcotest.(check string) __LOC__ expected actual let diff_print = [ "mine empty their no-nl", `Quick, print_diff_mine_empty_their_no_nl; "mine empty their nl", `Quick, print_diff_mine_empty_their_nl; "mine no-nl their empty", `Quick, print_diff_mine_no_nl_their_empty; "mine nl their empty", `Quick, print_diff_mine_nl_their_empty; "mine no-nl their no-nl", `Quick, print_diff_mine_no_nl_their_no_nl; "mine no-nl their nl", `Quick, print_diff_mine_no_nl_their_nl; "mine nl their no-nl", `Quick, print_diff_mine_nl_their_no_nl; "mine nl their nl", `Quick, print_diff_mine_nl_their_nl; ] let tests = [ "parse", parse_diffs ; "apply", apply_diffs ; "multiple", multi_diffs ; "filename", filename_diffs ; "regression basic", basic_regression_diffs ; "parse real diffs", parse_real_diff_headers ; "regression", regression_diffs ; "diff", unified_diff_creation ; "patch -p", patch_p; "pretty-print filenames", pp_filenames; "big diff", big_diff; "diff and print", diff_print; ] let () = Alcotest.run "Patch tests" tests patch-3.0.0/test/opam-repository/0000755000175000017500000000000015031511054020334 5ustar kit_ty_katekit_ty_katepatch-3.0.0/test/opam-repository/test.sh0000755000175000017500000000456315031511054021662 0ustar kit_ty_katekit_ty_kate#!/bin/sh set -e set -u set -o pipefail if test "$(dirname "$0")" != "." ; then echo "usage: ./test.sh" exit 1 fi export OPAMROOT=./.opam-root printf "Enter the path to the opam binary without builtin patch: " read -r OLD_OPAM printf "Enter the path to the opam binary with builtin patch: " read -r NEW_OPAM echo echo '## Getting the list of packages with patches' echo rm -f pkgs-with-patches rm -rf ./opam-repository git clone --depth=1 https://github.com/ocaml/opam-repository.git pushd ./opam-repository/packages > /dev/null grep -l '^patches:' */*/opam | cut -d/ -f2 >> ../../pkgs-with-patches popd > /dev/null rm -rf ./opam-repository-archive git clone --depth=1 https://github.com/ocaml/opam-repository-archive.git pushd ./opam-repository-archive/packages > /dev/null grep -l '^patches:' */*/opam | cut -d/ -f2 >> ../../pkgs-with-patches popd > /dev/null NB_OF_PKGS=$(cat ./pkgs-with-patches | wc -l) echo "Number of packages to process: ${NB_OF_PKGS}" rm_faulty_pkg_artefacts() { rm -rf ./ocaml-variants.4.10.0+nnpcheck/.git rm ./coq.8.7.1+1/test-suite/bugs/closed/4722/tata rm ./coq.8.7.1+2/test-suite/bugs/closed/4722/tata rm ./opa-base.1.1.0+4263/ocamllib/libbase/default.trx } echo echo "## Extract and apply patches using ${OLD_OPAM}" echo rm -rf ./tmp ./old mkdir ./tmp pushd ./tmp > /dev/null "${OLD_OPAM}" init --bare --no-setup --no-opamrc ../opam-repository "${OLD_OPAM}" repository add --set-default archive ../opam-repository-archive cat ../pkgs-with-patches | time -p xargs -n1 "${OLD_OPAM}" source > ../old.log 2>&1 || true rm_faulty_pkg_artefacts rm -rf "${OPAMROOT}" popd > /dev/null mv ./tmp ./old echo echo "## Extract and apply patches using ${NEW_OPAM}" echo rm -rf ./tmp ./new mkdir ./tmp pushd ./tmp > /dev/null "${NEW_OPAM}" init --bare --no-setup --no-opamrc ../opam-repository "${NEW_OPAM}" repository add --set-default archive ../opam-repository-archive cat ../pkgs-with-patches | time -p xargs -n1 "${NEW_OPAM}" source > ../new.log 2>&1 || true rm_faulty_pkg_artefacts rm -rf "${OPAMROOT}" popd > /dev/null mv ./tmp ./new echo >> ./test.log echo >> ./test.log echo "Run on the $(date):" >> ./test.log echo "Time of old run:" >> ./test.log tail -n3 ./old.log >> ./test.log echo "Time of new run:" >> ./test.log tail -n3 ./new.log >> ./test.log echo "Diff:" >> ./test.log diff -qr ./old ./new >> ./test.log 2>&1 || true echo "Done" >> ./test.log echo "Done." patch-3.0.0/test/opam-repository/.gitignore0000644000175000017500000000005515031511054022324 0ustar kit_ty_katekit_ty_kate/opam-repository /old /new /old.log /new.log patch-3.0.0/test/dune0000644000175000017500000000042715031511054016044 0ustar kit_ty_katekit_ty_kate(executable (name test) (modules test) (libraries patch alcotest)) (rule (alias runtest) (deps (source_tree data) (:< test.exe)) (action (run %{<}))) (executable (name crowbar_test) (modules crowbar_test) (libraries patch crowbar)) (dirs :standard \ opam-repository) patch-3.0.0/test/data/0000755000175000017500000000000015031511054016074 5ustar kit_ty_katekit_ty_katepatch-3.0.0/test/data/no-newline3.old0000644000175000017500000000000415031511054020724 0ustar kit_ty_katekit_ty_kateaaa patch-3.0.0/test/data/no-newline3.new0000644000175000017500000000000315031511054020736 0ustar kit_ty_katekit_ty_kateaaapatch-3.0.0/test/data/no-newline3.diff0000644000175000017500000000024215031511054021062 0ustar kit_ty_katekit_ty_kate--- no-newline3.old 2019-04-19 23:31:58.216807000 +0200 +++ no-newline3.new 2019-04-19 23:32:02.923740000 +0200 @@ -1 +1 @@ -aaa +aaa \ No newline at end of file patch-3.0.0/test/data/no-newline2.old0000644000175000017500000000000315031511054020722 0ustar kit_ty_katekit_ty_kateaaapatch-3.0.0/test/data/no-newline2.new0000644000175000017500000000000715031511054020741 0ustar kit_ty_katekit_ty_kateaaa bbbpatch-3.0.0/test/data/no-newline2.diff0000644000175000017500000000030515031511054021061 0ustar kit_ty_katekit_ty_kate--- no-newline2.old 2019-04-19 23:31:27.578096000 +0200 +++ no-newline2.new 2019-04-19 23:31:33.404503000 +0200 @@ -1 +1,2 @@ -aaa \ No newline at end of file +aaa +bbb \ No newline at end of file patch-3.0.0/test/data/no-newline.old0000644000175000017500000000000315031511054020640 0ustar kit_ty_katekit_ty_kateaaapatch-3.0.0/test/data/no-newline.new0000644000175000017500000000000415031511054020654 0ustar kit_ty_katekit_ty_kateaaa patch-3.0.0/test/data/no-newline.diff0000644000175000017500000000024015031511054020775 0ustar kit_ty_katekit_ty_kate--- no-newline.old 2019-04-19 23:30:16.195504000 +0200 +++ no-newline.new 2019-04-19 23:30:27.421032000 +0200 @@ -1 +1 @@ -aaa \ No newline at end of file +aaa patch-3.0.0/test/data/git4.diff0000644000175000017500000000020115031511054017566 0ustar kit_ty_katekit_ty_katediff --git a/git4.old b/git4.old deleted file mode 100644 index 257cc56..0000000 --- a/git4.old +++ /dev/null @@ -1 +0,0 @@ -foo patch-3.0.0/test/data/git3.old0000644000175000017500000000000415031511054017434 0ustar kit_ty_katekit_ty_katefoo patch-3.0.0/test/data/git3.new0000644000175000017500000000001015031511054017444 0ustar kit_ty_katekit_ty_katefoo bar patch-3.0.0/test/data/git3.diff0000644000175000017500000000024415031511054017574 0ustar kit_ty_katekit_ty_katediff --git a/git3.old b/git3.new similarity index 50% rename from a rename to c index 257cc56..3bd1f0e 100644 --- a/git3.old +++ b/git3.new @@ -1 +1,2 @@ foo +bar patch-3.0.0/test/data/git2.old0000644000175000017500000000000415031511054017433 0ustar kit_ty_katekit_ty_katefoo patch-3.0.0/test/data/git2.new0000644000175000017500000000000415031511054017446 0ustar kit_ty_katekit_ty_katefoo patch-3.0.0/test/data/git2.diff0000644000175000017500000000013715031511054017574 0ustar kit_ty_katekit_ty_katediff --git a/git2.old b/git2.new similarity index 100% rename from git2.old rename to git2.new patch-3.0.0/test/data/git1.new0000644000175000017500000000000415031511054017445 0ustar kit_ty_katekit_ty_katefoo patch-3.0.0/test/data/git1.diff0000644000175000017500000000017515031511054017575 0ustar kit_ty_katekit_ty_katediff --git a/git1.new b/git1.new new file mode 100644 index 0000000..257cc56 --- /dev/null +++ b/git1.new @@ -0,0 +1 @@ +foo patch-3.0.0/test/data/first.old0000644000175000017500000000022015031511054017715 0ustar kit_ty_katekit_ty_katefoo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo patch-3.0.0/test/data/first.new0000644000175000017500000000025715031511054017742 0ustar kit_ty_katekit_ty_katefoo foo foo foo3 foo foo foo foo foo foo foo foo foo5 foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo bar foo foo foo foo foo foo bar2 patch-3.0.0/test/data/first.diff0000644000175000017500000000043015031511054020052 0ustar kit_ty_katekit_ty_kate--- first.old 2019-03-10 19:09:28.825116000 +0100 +++ first.new 2019-03-10 19:09:36.053702000 +0100 @@ -1,6 +1,7 @@ foo foo foo +foo3 foo foo foo @@ -9,6 +10,7 @@ foo foo foo +foo5 foo foo foo @@ -31,6 +33,11 @@ foo foo foo +bar foo foo foo +foo +foo +foo +bar2 patch-3.0.0/test/data/external/0000755000175000017500000000000015031511054017716 5ustar kit_ty_katekit_ty_katepatch-3.0.0/test/data/dns.opam.old0000644000175000017500000000306715031511054020321 0ustar kit_ty_katekit_ty_kateopam-version: "2.0" maintainer: "team AT robur dot coop" authors: ["Hannes Mehnert " "Reynir Björnsson "] homepage: "https://github.com/mirage/ocaml-dns" doc: "https://mirage.github.io/ocaml-dns/" dev-repo: "git+https://github.com/mirage/ocaml-dns.git" bug-reports: "https://github.com/mirage/ocaml-dns/issues" license: "BSD-2-Clause" depends: [ "dune" {>= "2.0.0"} "ocaml" {>= "4.08.0"} "logs" "ptime" "fmt" {>= "0.8.8"} "domain-name" {>= "0.4.0"} "gmap" {>= "0.3.0"} "cstruct" {>= "6.0.0"} "ipaddr" {>= "5.2.0"} "alcotest" {with-test} "lru" {>= "0.3.0"} "duration" {>= "0.1.2"} "metrics" "base64" {>= "3.3.0"} ] conflicts: [ "result" {< "1.5"} ] build: [ ["dune" "subst"] {dev} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] synopsis: "An opinionated Domain Name System (DNS) library" description: """ µDNS supports most of the domain name system used in the wild. It adheres to strict conventions. Failing early and hard. It is mostly implemented in the pure fragment of OCaml (no mutation, isolated IO, no exceptions). Legacy resource record types are not dealt with, and there is no plan to support `ISDN`, `MAILA`, `MAILB`, `WKS`, `MB`, `NULL`, `HINFO`, ... . `AXFR` is only handled via TCP connections. The only resource class supported is `IN` (the Internet). Truncated hmac in `TSIG` are not supported (always the full length of the hash algorithm is used). Please read [the blog article](https://hannes.nqsb.io/Posts/DNS) for a more detailed overview. """ patch-3.0.0/test/data/dns.opam.new0000644000175000017500000000306615031511054020333 0ustar kit_ty_katekit_ty_kateopam-version: "2.0" maintainer: "team AT robur dot coop" authors: ["Hannes Mehnert " "Reynir Björnsson "] homepage: "https://github.com/mirage/ocaml-dns" doc: "https://mirage.github.io/ocaml-dns/" dev-repo: "git+https://github.com/mirage/ocaml-dns.git" bug-reports: "https://github.com/mirage/ocaml-dns/issues" license: "BSD-2-Clause" depends: [ "dune" {>= "2.0.0"} "ocaml" {>= "4.08.0"} "logs" "ptime" "fmt" {>= "0.8.8"} "domain-name" {>= "0.4.0"} "gmap" {>= "0.3.0"} "cstruct" {>= "6.0.0"} "ipaddr" {>= "5.2.0"} "alcotest" {with-test} "lru" {>= "0.3.0"} "duration" {>= "0.1.2"} "metrics" "base64" {>= "3.3.0"} ] conflicts: [ "result" {< "1.5"} ] build: [ ["dune" "subst"] {dev} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] synopsis: "An opinionated Domain Name System (DNS) library" description: """ µDNS supports most of the domain name system used in the wild. It adheres to strict conventions. Failing early and hard. It is mostly implemented in the pure fragment of OCaml (no mutation, isolated IO, no exceptions). Legacy resource record types are not dealt with, and there is no plan to support `ISDN`, `MAILA`, `MAILB`, `WKS`, `MB`, `NULL`, `HINFO`, ... . `AXFR` is only handled via TCP connections. The only resource class supported is `IN` (the Internet). Truncated hmac in `TSIG` are not supported (always the full length of the hash algorithm is used). Please read [the blog article](https://hannes.nqsb.io/Posts/DNS) for a more detailed overview. """ patch-3.0.0/test/data/dns.opam.diff0000644000175000017500000000112215031511054020441 0ustar kit_ty_katekit_ty_kateFrom 685882a290abefe31adf75a2ae6f7cfa0516b38c Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Thu, 21 Mar 2024 10:16:54 +0100 Subject: [PATCH] minor --- dns.opam | 1 - 1 file changed, 1 deletion(-) diff --git a/dns.opam b/dns.opam index bae79cb..59083db 100644 --- a/dns.opam +++ b/dns.opam @@ -6,7 +6,6 @@ doc: "https://mirage.github.io/ocaml-dns/" dev-repo: "git+https://github.com/mirage/ocaml-dns.git" bug-reports: "https://github.com/mirage/ocaml-dns/issues" license: "BSD-2-Clause" - depends: [ "dune" {>= "2.0.0"} "ocaml" {>= "4.08.0"} -- 2.42.0 patch-3.0.0/test/data/delete-newline-only.old0000644000175000017500000000000115031511054022443 0ustar kit_ty_katekit_ty_kate patch-3.0.0/test/data/delete-newline-only.diff0000644000175000017500000000030215031511054022601 0ustar kit_ty_katekit_ty_katediff -ruN b/delete-newline-only a/delete-newline-only --- b/delete-newline-only 2025-04-30 19:12:35.180584541 +0100 +++ a/delete-newline-only 1970-01-01 01:00:00.000000000 +0100 @@ -1 +0,0 @@ - patch-3.0.0/test/data/delete-empty-only.old0000644000175000017500000000000015031511054022137 0ustar kit_ty_katekit_ty_katepatch-3.0.0/test/data/delete-empty-only.diff0000644000175000017500000000014315031511054022301 0ustar kit_ty_katekit_ty_katediff --git b/delete-empty-only b/delete-empty-only deleted file mode 100644 index e69de29..0000000 patch-3.0.0/test/data/crowbar1.old0000644000175000017500000000000215031511054020304 0ustar kit_ty_katekit_ty_kate xpatch-3.0.0/test/data/crowbar1.new0000644000175000017500000000000115031511054020316 0ustar kit_ty_katekit_ty_kate patch-3.0.0/test/data/crowbar1.diff0000644000175000017500000000012115031511054020440 0ustar kit_ty_katekit_ty_kate--- crowbar1.old +++ crowbar1.new @@ -1,2 +1 @@ -x \ No newline at end of file patch-3.0.0/test/data/create1.new0000644000175000017500000000000415031511054020125 0ustar kit_ty_katekit_ty_katefoo patch-3.0.0/test/data/create1.diff0000644000175000017500000000005715031511054020254 0ustar kit_ty_katekit_ty_kate--- /dev/null +++ a/create1 @@ -0,0 +1 @@ +foo patch-3.0.0/test/data/create-newline-only.new0000644000175000017500000000000115031511054022457 0ustar kit_ty_katekit_ty_kate patch-3.0.0/test/data/create-newline-only.diff0000644000175000017500000000030215031511054022602 0ustar kit_ty_katekit_ty_katediff -ruN a/create-newline-only b/create-newline-only --- a/create-newline-only 1970-01-01 01:00:00.000000000 +0100 +++ b/create-newline-only 2025-04-30 19:12:35.180584541 +0100 @@ -0,0 +1 @@ + patch-3.0.0/test/data/create-empty-only.new0000644000175000017500000000000015031511054022153 0ustar kit_ty_katekit_ty_katepatch-3.0.0/test/data/create-empty-only.diff0000644000175000017500000000013715031511054022305 0ustar kit_ty_katekit_ty_katediff --git b/create-empty-only b/create-empty-only new file mode 100644 index 0000000..e69de29 patch-3.0.0/test/crowbar_test.ml0000644000175000017500000001065415031511054020221 0ustar kit_ty_katekit_ty_kate(** USAGE: This test works by generating two files (source and target), diffing them using the system `diff -u` command, applying our Patch code to the source file, and checking that we get the target back. Counter-examples will give you the source and target file. From the root repository, run dune exec test/crowbar_test.exe to get quicheck-like (blackbox) fuzzing, and mkdir -p /tmp/input mkdir -p /tmp/output echo foo > /tmp/input/test dune build test/crowbar_test.exe afl-fuzz -i /tmp/input -o /tmp/output dune exec test/crowbar_test.exe @@ for AFL-full (greybox) fuzzing. If you find a counter-example, you can use src/patch_command to reproduce the issue. For example, if the quickcheck mode tells you: > patch: .... > patch: FAIL > > When given the input: > > ["\nx"; "\n"] > > the test failed: > > "" != "\n" > You can run echo -n -e "\nx" > file1 echo -n -e "\n" > file2 diff -u file1 file2 > diff patch file1 diff -o file2-std-patch dune exec src/patch_command.exe -- file1 diff -o file2-our-patch diff file2-our-patch file2-std-patch rm file1 file2 diff file2-std-patch file2-our-patch to check for yourself. *) type line = string type file = line list let string_of_file = String.concat "" module Printer = struct open Crowbar let line : line printer = fun ppf line -> pp ppf "%S" line let file : file printer = fun ppf file -> pp ppf "%S" (String.concat "" file) end module Gen = struct open Crowbar let char : string gen = map [range 25] (fun n -> String.make 1 (char_of_int (int_of_char 'a' + n))) let line : line gen = with_printer Printer.line @@ map [list char] (fun s -> String.concat "" (s @ ["\n"])) let line_no_eol : line gen = with_printer Printer.line @@ map [list char] (fun s -> String.concat "" s) let file : file gen = with_printer Printer.file @@ choose [ list line; map [list line; line_no_eol] (fun lines line -> lines @ [line]); ] end module IO = struct let read input = let rec loop buf acc input = match input_char input with | exception End_of_file -> if Buffer.length buf = 0 then List.rev acc else List.rev (Buffer.contents buf :: acc) | '\n' -> Buffer.add_char buf '\n'; let line = Buffer.contents buf in Buffer.clear buf; loop buf (line :: acc) input | c -> Buffer.add_char buf c; loop buf acc input in loop (Buffer.create 80) [] input let write output file = List.iter (output_string output) file; () let with_file_out file k = let (path, oc) = Filename.open_temp_file "patch_crowbar" "" in let clean () = close_out oc; Sys.remove path in write oc file; flush oc; match k path with | exception exn -> clean (); raise exn | res -> clean (); res let with_tmp k = let path = Filename.temp_file "patch_crowbar_diff" "" in let clean () = Sys.remove path in match k path with | exception exn -> clean (); raise exn | res -> clean (); res end (** getting a system *diff* from two files *) let get_diffs (file1 : file) (file2 : file) : file = IO.with_file_out file1 @@ fun path1 -> IO.with_file_out file2 @@ fun path2 -> IO.with_tmp @@ fun path_out -> Printf.ksprintf (fun cmd -> ignore (Sys.command cmd)) "diff -u %S %S > %S" path1 path2 path_out; let input = open_in path_out in let res = IO.read input in close_in input; res let check_Patch file1 file2 = let text_diff = string_of_file (get_diffs file1 file2) in 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] -> let data = string_of_file file1 in match Patch.patch ~cleanly:true (Some data) diff with | None -> let exp = string_of_file file2 in Crowbar.fail ("input file\n" ^ data ^ "\ndiff\n" ^ text_diff ^ "\nexpected\n" ^ exp) | Some output -> let exp = string_of_file file2 in if String.equal exp output then Crowbar.check_eq ~pp:Crowbar.pp_string output exp else Crowbar.fail ("input fileFFF\n" ^ data ^ "FFF\ndiffFFF\n" ^ text_diff ^ "FFF\nexpectedFFF\n" ^ exp ^ "FFF") let () = Crowbar.(add_test ~name:"patch" [Gen.file; Gen.file] check_Patch) patch-3.0.0/src/0000755000175000017500000000000015031511054014773 5ustar kit_ty_katekit_ty_katepatch-3.0.0/src/patch_command.ml0000644000175000017500000000507615031511054020132 0ustar kit_ty_katekit_ty_kate(** For now this command is only used for testing, in particular it is not installed to the user. (If we wanted to install it, it would need a better name.) *) let usage = "Simplified patch utility for single-file patches;\n ./patch.exe -p -o " let exit_command_line_error = 1 let exit_open_error = 2 let exit_several_chunks = 3 let exit_patch_failure = 4 let run ~p ~input ~diff = match Patch.parse ~p diff with | [] -> input | _::_::_ -> prerr_endline "Error: The diff contains several chunks,\n\ which is not supported by this command."; exit exit_several_chunks | [diff] -> begin match Patch.patch ~cleanly:true (Some input) diff with | None -> Printf.eprintf "Error during patching:\n%!"; exit exit_patch_failure | Some output -> output end module IO = struct let read input = let rec loop buf input = match input_char input with | exception End_of_file -> Buffer.contents buf | c -> Buffer.add_char buf c; loop buf input in loop (Buffer.create 80) input let write output data = String.iter (output_char output) data; flush output; () end let () = if Array.length Sys.argv = 1 then begin prerr_endline usage; exit 0; end; 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 with _ -> prerr_endline "Error parsing the command-line arguments"; prerr_endline usage; prerr_newline (); exit exit_command_line_error in let get_data path = match open_in path with | exception _ -> Printf.eprintf "Error: unable to open file %S for reading\n%!" path; exit exit_open_error | input -> let data = IO.read input in close_in input; data in let write_data path ~data = match open_out path with | exception _ -> Printf.eprintf "Error: unable to open file %S for writing\n%!" path; exit exit_open_error | output -> IO.write output data; close_out output in let input_data = get_data input_path in let diff_data = get_data diff_path in let output_data = run ~p ~input:input_data ~diff:diff_data in write_data output_path ~data:output_data patch-3.0.0/src/patch.mli0000644000175000017500000000645415031511054016606 0ustar kit_ty_katekit_ty_kate(** Patch - parsing and applying unified diffs in pure OCaml *) type hunk = { mine_start : int ; mine_len : int ; mine : string list ; their_start : int ; their_len : int ; their : string list ; } (** A hunk contains some difference between two files: each with a start line and length, and then the content as lists of string. *) type parse_error = { msg : string; lines : string list; } exception Parse_error of parse_error val pp_hunk : mine_no_nl:bool -> their_no_nl:bool -> Format.formatter -> hunk -> unit (** [pp_hunk ppf hunk] pretty-prints the [hunk] on [ppf], the printing is in the same format as [diff] does. *) type git_ext = | Rename_only of string * string | Delete_only | Create_only type operation = | Edit of string * string | Delete of string | Create of string | Git_ext of (string * string * git_ext) (** The operation of a diff: in-place [Edit], [Delete], [Create]. And its git-extensions: [Rename_only], [Delete_only], [Create_only]. The parameters to the variants are filenames. Note that [Edit] also renames the given file under certain conditions and the file to use is driven by this POSIX rule: https://pubs.opengroup.org/onlinepubs/9799919799/utilities/patch.html#tag_20_92_13_02 Note also that the two filenames in [Git_ext] represent what would be in [git --diff ] with their respective prefixes removed if parsed with [parse ~p:1] or above. Warning: The two parameters of [Rename_only] represent the values of the [rename from ] and [rename to ] following the specs of the git extensions. Following the behaviour of GNU Patch which ignores these two lines, it is recommended to get the filenames from [Git_ext] instead of from [Rename_only], which are used only for pretty-printing. *) 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. *) type t = { operation : operation ; hunks : hunk list ; mine_no_nl : bool ; their_no_nl : bool ; } (** 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 : Format.formatter -> t -> unit (** [pp ppf t] pretty-prints [t] on [ppf]. *) val pp_list : Format.formatter -> t list -> unit (** [pp ppf diffs] pretty-prints [diffs] on [ppf]. *) 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 *) val patch : cleanly:bool -> string option -> t -> string option (** [patch file_contents diff] applies [diff] on [file_contents], resulting in the new file contents (or None if deleted). *) val diff : (string * string) option -> (string * string) option -> t option (** [diff (filename_a, content_a) (filename_b, content_b)] creates a diff between [content_a] and [content_b]. Returns [None] if no changes could be detected. @raise Invalid_argument if both arguments are [None]. *) patch-3.0.0/src/patch.ml0000644000175000017500000005425115031511054016433 0ustar kit_ty_katekit_ty_katetype hunk = { mine_start : int ; mine_len : int ; mine : string list ; their_start : int ; their_len : int ; their : string list ; } type parse_error = { msg : string; lines : string list; (* TODO: add the start position of the error *) } exception Parse_error of parse_error let unified_diff ~mine_no_nl ~their_no_nl hunk = let buf = Buffer.create 4096 in let add_no_nl buf = Buffer.add_string buf "\\ No newline at end of file\n" in let add_line buf c line = Buffer.add_char buf c; Buffer.add_string buf line; Buffer.add_char buf '\n'; in List.iter (add_line buf '-') hunk.mine; if mine_no_nl then add_no_nl buf; List.iter (add_line buf '+') hunk.their; if their_no_nl then add_no_nl buf; Buffer.contents buf let pp_hunk ~mine_no_nl ~their_no_nl ppf hunk = Format.fprintf ppf "%@%@ -%d,%d +%d,%d %@%@\n%s" hunk.mine_start hunk.mine_len hunk.their_start hunk.their_len (unified_diff ~mine_no_nl ~their_no_nl hunk) let rec apply_hunk ~cleanly ~fuzz (last_matched_line, offset, lines) ({mine_start; mine_len; mine; their_start = _; their_len; their} as hunk) = let mine_start = mine_start + offset in let patch_match ~search_offset = let mine_start = mine_start + search_offset in let rev_prefix, rest = Lib.List.rev_cut (Stdlib.max 0 (mine_start - 1)) lines in let rev_actual_mine, suffix = Lib.List.rev_cut mine_len rest in let actual_mine = List.rev rev_actual_mine in if actual_mine <> (mine : string list) then invalid_arg "unequal mine"; (* TODO: should we check their_len against List.length their? *) (mine_start + mine_len, offset + (their_len - mine_len), (* TODO: Replace rev_append (rev ...) by the tail-rec when patch requires OCaml >= 4.14 *) List.rev_append rev_prefix (List.rev_append (List.rev their) suffix)) in try patch_match ~search_offset:0 with Invalid_argument _ -> if cleanly then invalid_arg "apply_hunk" else let max_pos_offset = Stdlib.max 0 (List.length lines - Stdlib.max 0 (mine_start - 1) - mine_len) in let max_neg_offset = mine_start - last_matched_line in let rec locate search_offset = let aux search_offset max_offset = try if search_offset <= max_offset then Some (patch_match ~search_offset) else None with Invalid_argument _ -> None in if search_offset > max_pos_offset && search_offset > max_neg_offset then if fuzz < 3 && List.length mine >= 2 && List.length their >= 2 then let hunk = if List.hd hunk.mine = (List.hd hunk.their : string) then { mine_start = hunk.mine_start + 1; mine_len = hunk.mine_len - 1; mine = List.tl hunk.mine; their_start = hunk.their_start + 1; their_len = hunk.their_len - 1; their = List.tl hunk.their; } else hunk in let hunk = if Lib.List.last hunk.mine = (Lib.List.last hunk.their : string) then { mine_start = hunk.mine_start; mine_len = hunk.mine_len - 1; mine = List.rev (List.tl (List.rev hunk.mine)); their_start = hunk.their_start; their_len = hunk.their_len - 1; their = List.rev (List.tl (List.rev hunk.their)); } else hunk in if hunk.mine_len = 0 && hunk.their_len = 0 then invalid_arg "apply_hunk: equal hunks... why?!" else if mine_len = (hunk.mine_len : int) && their_len = (hunk.their_len : int) then invalid_arg "apply_hunk: could not apply fuzz" else apply_hunk ~cleanly ~fuzz:(fuzz + 1) (last_matched_line, offset, lines) hunk else invalid_arg "apply_hunk" else match aux search_offset max_pos_offset with | Some x -> x | None -> match aux (-search_offset) max_neg_offset with | Some x -> x | None -> locate (search_offset + 1) in locate 1 let to_start_len data = (* input being "?19,23" *) match Lib.String.cut ',' (Lib.String.slice ~start:1 data) with | None when data = "+1" || data = "-1" -> (1, 1) | None -> invalid_arg ("start_len broken in " ^ data) | Some (start, len) -> (int_of_string start, int_of_string len) let count_to_sl_sl data = if Lib.String.is_prefix ~prefix:"@@ -" data then (* input: "@@ -19,23 +19,12 @@ bla" *) (* output: ((19,23), (19, 12)) *) match List.filter (function "" -> false | _ -> true) (Lib.String.cuts '@' data) with | numbers::_ -> let nums = String.trim numbers in (match Lib.String.cut ' ' nums with | None -> invalid_arg "couldn't find space in count" | Some (mine, theirs) -> Some (to_start_len mine, to_start_len theirs)) | _ -> invalid_arg "broken line!" else None let sort_into_bags ~counter:(mine_len, their_len) dir mine their m_nl t_nl str = let both data = if m_nl || t_nl then failwith "\"no newline at the end of file\" is not at the end of the file"; if mine_len = 0 || their_len = 0 then failwith "invalid patch (both size exhausted)"; let counter = (mine_len - 1, their_len - 1) in Some (counter, `Both, (data :: mine), (data :: their), m_nl, t_nl) in let str_len = String.length str in if mine_len = 0 && their_len = 0 && (str_len = 0 || str.[0] <> '\\') then None else if str_len = 0 then both "" (* NOTE: this should technically be a parse error but GNU patch accepts that and some patches in opam-repository do use this behaviour *) else match String.get str 0, Lib.String.slice ~start:1 str with | ' ', data -> both data | '\t', data -> both ("\t"^data) (* NOTE: not valid but accepted by GNU patch *) | '+', data -> if t_nl then failwith "\"no newline at the end of file\" is not at the end of the file"; if their_len = 0 then failwith "invalid patch (+ size exhausted)"; let counter = (mine_len, their_len - 1) in Some (counter, `Their, mine, (data :: their), m_nl, t_nl) | '-', data -> if m_nl then failwith "\"no newline at the end of file\" is not at the end of the file"; if mine_len = 0 then failwith "invalid patch (- size exhausted)"; let counter = (mine_len - 1, their_len) in Some (counter, `Mine, (data :: mine), their, m_nl, t_nl) | '\\', _data -> (* NOTE: Any line starting with '\' is taken as if it was '\ No newline at end of file' by GNU patch so we do the same *) (* diff: 'No newline at end of file' turns out to be context-sensitive *) (* so: -xxx\n\\No newline... means mine didn't have a newline *) (* but +xxx\n\\No newline... means theirs doesn't have a newline *) let my_nl, their_nl = match dir with | `Both -> true, true | `Mine -> true, t_nl | `Their -> m_nl, true in let counter = (mine_len, their_len) in Some (counter, dir, mine, their, my_nl, their_nl) | _ -> failwith "invalid patch (unknown character)" let to_hunk count data mine_no_nl their_no_nl = match count_to_sl_sl count with | None -> None, mine_no_nl, their_no_nl, count :: data | Some ((mine_start, mine_len), (their_start, their_len)) -> let counter = (mine_len, their_len) in let rec step ~counter dir mine their mine_no_nl their_no_nl = function | [] | [""] when counter = (0, 0) -> (List.rev mine, List.rev their, mine_no_nl, their_no_nl, []) | [""] when counter = (1, 1) -> (List.rev ("" :: mine), List.rev ("" :: their), mine_no_nl, their_no_nl, []) (* GNU patch behaviour *) | [""] when counter = (2, 2) -> (List.rev ("" :: "" :: mine), List.rev ("" :: "" :: their), mine_no_nl, their_no_nl, []) (* GNU patch behaviour *) | [""] when counter = (3, 3) -> (List.rev ("" :: "" :: "" :: mine), List.rev ("" :: "" :: "" :: their), mine_no_nl, their_no_nl, []) (* GNU patch behaviour *) | [] | [""] -> failwith "bad file" | x::xs -> match sort_into_bags ~counter dir mine their mine_no_nl their_no_nl x with | Some (counter, dir, mine, their, mine_no_nl', their_no_nl') -> step ~counter dir mine their mine_no_nl' their_no_nl' xs | None -> (List.rev mine, List.rev their, mine_no_nl, their_no_nl, x :: xs) in let mine, their, mine_no_nl, their_no_nl, rest = step ~counter `Both [] [] mine_no_nl their_no_nl data in (Some { mine_start ; mine_len ; mine ; their_start ; their_len ; their }, mine_no_nl, their_no_nl, rest) let rec to_hunks (mine_no_nl, their_no_nl, acc) = function | [] -> (List.rev acc, mine_no_nl, their_no_nl, []) | count::data -> match to_hunk count data mine_no_nl their_no_nl with | None, mine_no_nl, their_no_nl, rest -> List.rev acc, mine_no_nl, their_no_nl, rest | Some hunk, mine_no_nl, their_no_nl, rest -> to_hunks (mine_no_nl, their_no_nl, hunk :: acc) rest type git_ext = | Rename_only of string * string | Delete_only | Create_only type operation = | Edit of string * string | Delete of string | Create of string | Git_ext of (string * string * git_ext) let git_ext_eq a b = match a, b with | Delete_only, Delete_only | Create_only, Create_only -> true | Rename_only (a, b), Rename_only (a', b') -> String.equal a a' && String.equal b b' | Rename_only _, _ | Delete_only, _ | Create_only, _ -> false let operation_eq a b = match a, b with | Delete a, Delete b | Create a, Create b -> String.equal a b | Edit (a, b), Edit (a', b') -> String.equal a a' && String.equal b b' | Git_ext (a, b, ext1), Git_ext (a', b', ext2) -> String.equal a a' && String.equal b b' && git_ext_eq ext1 ext2 | Edit _, _ | Delete _, _ | Create _, _ | Git_ext _, _ -> false let no_file = "/dev/null" let pp_filename ppf fn = (* NOTE: filename quote format from GNU diffutils *) let rec aux ~to_quote buf fn ~len i = if i < len then let c = fn.[i] in let to_quote = if c = '\007' then (Buffer.add_string buf "\\a"; true) else if c = '\b' then (Buffer.add_string buf "\\b"; true) else if c = '\t' then (Buffer.add_string buf "\\t"; true) else if c = '\n' then (Buffer.add_string buf "\\n"; true) else if c = '\011' then (Buffer.add_string buf "\\v"; true) else if c = '\012' then (Buffer.add_string buf "\\f"; true) else if c = '\r' then (Buffer.add_string buf "\\r"; true) else if c < ' ' || c > '~' then (Printf.bprintf buf "\\%03o" (Char.code c); true) else if c = ' ' then (Buffer.add_char buf ' '; true) else if c = '"' || c = '\\' then (Buffer.add_char buf '\\'; Buffer.add_char buf c; true) else (Buffer.add_char buf c; to_quote) in aux ~to_quote buf fn ~len (i + 1) else to_quote in let len = String.length fn in let buf = Buffer.create (len * 2) in if aux ~to_quote:false buf fn ~len 0 then Format.fprintf ppf "\"%s\"" (Buffer.contents buf) else Format.pp_print_text ppf fn let pp_operation ppf = function | Edit (old_name, new_name) -> Format.fprintf ppf "--- %a\n" pp_filename old_name ; Format.fprintf ppf "+++ %a\n" pp_filename new_name | Delete name -> Format.fprintf ppf "--- %a\n" pp_filename name ; Format.fprintf ppf "+++ %a\n" pp_filename no_file | Create name -> Format.fprintf ppf "--- %a\n" pp_filename no_file ; Format.fprintf ppf "+++ %a\n" pp_filename name | Git_ext (a, b, ext) -> Format.fprintf ppf "diff --git %a %a\n" pp_filename a pp_filename b; match ext with | Rename_only (from_, to_) -> Format.fprintf ppf "rename from %a\n" pp_filename from_; Format.fprintf ppf "rename to %a\n" pp_filename to_ | Delete_only -> Format.pp_print_string ppf "deleted file mode 100644\n"; | Create_only -> Format.pp_print_string ppf "new file mode 100644\n"; type t = { operation : operation ; hunks : hunk list ; mine_no_nl : bool ; their_no_nl : bool ; } let pp ppf {operation; hunks; mine_no_nl; their_no_nl} = pp_operation ppf operation; let rec aux = function | [] -> begin match operation with | Edit _ | Delete _ | Create _ -> assert false | Git_ext _ -> () (* already delt with in pp_operation *) end | [x] -> pp_hunk ~mine_no_nl ~their_no_nl ppf x | x::xs -> pp_hunk ~mine_no_nl:false ~their_no_nl:false ppf x; aux xs in aux hunks let pp_list ppf diffs = List.iter (Format.fprintf ppf "%a" pp) diffs let strip_prefix ~p filename = if p = 0 then filename else match Lib.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 let rec drop_up_to n = function | [] -> assert false | l when n = 0 -> l | [_] -> failwith "wrong prefix" | _::xs -> drop_up_to (n - 1) xs in (* GNU patch just drops the max number of slashes when the filename doesn't have enough slashes to satisfy -p *) match drop_up_to p filename' with | [] -> assert false | l -> String.concat "/" l let operation_of_strings ~p mine their = let mine_fn = Lib.String.slice ~start:4 mine and their_fn = Lib.String.slice ~start:4 their in match Fname.parse mine_fn, Fname.parse their_fn with | 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 ~p data = let open (struct type mode = Git of string end) in let is_git = function | Some (Git _) -> true | None -> false in (* first locate --- and +++ lines *) let rec find_start ~mode ~git_action = function | [] -> begin match git_action with | Some git_action -> Some (Git_ext git_action), [] | None -> None, [] end | x::xs when Lib.String.is_prefix ~prefix:"diff --git " x -> begin match mode, git_action with | (None | Some (Git _)), None -> find_start ~mode:(Some (Git x)) ~git_action:None xs | None, Some _ -> assert false (* impossible state *) | Some (Git _), Some git_action -> (Some (Git_ext git_action), x :: xs) end | x::y::xs when is_git mode && Lib.String.is_prefix ~prefix:"rename from " x && Lib.String.is_prefix ~prefix:"rename to " y -> let git_action = match mode with | None -> assert false | Some (Git git_filenames) -> let from_ = Lib.String.slice ~start:12 x in let to_ = Lib.String.slice ~start:10 y in let git_filenames = Lib.String.slice ~start:11 git_filenames in match Fname.parse_git_header_rename ~from_ ~to_ git_filenames with | None -> git_action | Some (a, b) -> let a = strip_prefix ~p a in let b = strip_prefix ~p b in Some (a, b, Rename_only (from_, to_)) in find_start ~mode ~git_action xs | x::xs when is_git mode && Lib.String.is_prefix ~prefix:"deleted file mode " x -> let git_action = match mode with | None -> assert false | Some (Git git_filenames) -> let git_filenames = Lib.String.slice ~start:11 git_filenames in match Fname.parse_git_header_same git_filenames with | None -> git_action | Some (a, b) -> let a = strip_prefix ~p a in let b = strip_prefix ~p b in Some (a, b, Delete_only) in find_start ~mode ~git_action xs | x::xs when is_git mode && Lib.String.is_prefix ~prefix:"new file mode " x -> let git_action = match mode with | None -> assert false | Some (Git git_filenames) -> let git_filenames = Lib.String.slice ~start:11 git_filenames in match Fname.parse_git_header_same git_filenames with | None -> git_action | Some (a, b) -> let a = strip_prefix ~p a in let b = strip_prefix ~p b in Some (a, b, Create_only) in find_start ~mode ~git_action xs | x::y::xs when Lib.String.is_prefix ~prefix:"--- " x && Lib.String.is_prefix ~prefix:"+++ " y -> begin match git_action, operation_of_strings ~p x y with | None, op -> Some op, xs | Some (f, _, Delete_only), (Delete f' as op) | Some (_, f, Create_only), (Create f' as op) when String.equal f f' -> Some op, xs | Some (a, b, Rename_only (_, _)), (Edit (a', b') as op) when String.equal a a' && String.equal b b' -> Some op, xs | Some (_, _, (Rename_only _ | Delete_only | Create_only) as git_op), _ -> Some (Git_ext git_op), x :: y :: xs end | x::y::_xs when Lib.String.is_prefix ~prefix:"*** " x && Lib.String.is_prefix ~prefix:"--- " y -> failwith "Context diffs are not supported" | _::xs -> find_start ~mode ~git_action xs in match find_start ~mode:None ~git_action:None data with | Some (Git_ext _ 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) | Some operation, rest -> let hunks, mine_no_nl, their_no_nl, rest = to_hunks (false, false, []) rest in Some ({ operation ; hunks ; mine_no_nl ; their_no_nl }, rest) | None, [] -> None | None, _ -> assert false let to_lines = String.split_on_char '\n' let parse ~p data = let lines = to_lines data in let rec doit ~p acc = function | [] -> List.rev acc | xs -> match parse_one ~p xs with | None -> List.rev acc | Some (diff, rest) -> doit ~p (diff :: acc) rest in doit ~p [] lines let patch ~cleanly filedata diff = match diff.operation with | Git_ext (_, _, ext) -> if diff.hunks <> [] then assert false; begin match ext with | Rename_only _ -> filedata | Delete_only -> None | Create_only -> Some "" end | Delete _ -> None | Create _ -> begin match diff.hunks with | [ the_hunk ] -> let lines = String.concat "\n" the_hunk.their in let lines = if diff.their_no_nl then lines else lines ^ "\n" in Some lines | _ -> assert false end | Edit _ -> let old = match filedata with None -> [] | Some x -> to_lines x in let _, _, lines = List.fold_left (apply_hunk ~cleanly ~fuzz:0) (0, 0, old) diff.hunks in let lines = String.concat "\n" lines in let lines = match diff.mine_no_nl, diff.their_no_nl with | false, true -> let len = String.length lines in if len > 0 && String.unsafe_get lines (len - 1) = '\n' then Lib.String.slice ~stop:(len - 1) lines else lines | true, false -> lines ^ "\n" | false, false -> lines | true, true -> lines in Some lines let diff_op operation a b = let rec aux ~mine_start ~mine_len ~mine ~their_start ~their_len ~their l1 l2 = let create_diff ~mine_no_nl ~their_no_nl = let hunks = if mine = [] && their = [] then assert false else let mine = List.rev mine in let their = List.rev their in [{mine_start; mine_len; mine; their_start; their_len; their}] in {operation; hunks; mine_no_nl; their_no_nl} in match l1, l2 with | [], [] | [""], [""] when mine = [] && their = [] -> assert false | [], [] -> Some (create_diff ~mine_no_nl:true ~their_no_nl:true) | [""], [] -> Some (create_diff ~mine_no_nl:false ~their_no_nl:true) | [], [""] -> Some (create_diff ~mine_no_nl:true ~their_no_nl:false) | [""], [""] -> Some (create_diff ~mine_no_nl:false ~their_no_nl:false) | a::l1, ([] | [""]) -> aux ~mine_start ~mine_len:(mine_len + 1) ~mine:(a :: mine) ~their_start ~their_len ~their l1 l2 | ([] | [""]), b::l2 -> aux ~mine_start ~mine_len ~mine ~their_start ~their_len:(their_len + 1) ~their:(b :: their) l1 l2 | a::(_::_ as l1), [b] -> aux ~mine_start ~mine_len:(mine_len + 1) ~mine:(a :: mine) ~their_start ~their_len:(their_len + 1) ~their:(b :: their) l1 [] | [a], b::(_::_ as l2) -> aux ~mine_start ~mine_len:(mine_len + 1) ~mine:(a :: mine) ~their_start ~their_len:(their_len + 1) ~their:(b :: their) [] l2 | a::l1, b::l2 when mine = [] && their = [] && String.equal a b -> aux ~mine_start:(mine_start + 1) ~mine_len ~mine ~their_start:(their_start + 1) ~their_len ~their l1 l2 | a::l1, b::l2 -> aux ~mine_start ~mine_len:(mine_len + 1) ~mine:(a :: mine) ~their_start ~their_len:(their_len + 1) ~their:(b :: their) l1 l2 in aux ~mine_start:(if a = "" then 0 else 1) ~mine_len:0 ~mine:[] ~their_start:(if b = "" then 0 else 1) ~their_len:0 ~their:[] (to_lines a) (to_lines b) let diff a b = match a, b with | None, None -> invalid_arg "no input given" | None, Some (filename_b, "") -> Some { operation = Git_ext (filename_b, filename_b, Create_only); hunks = []; mine_no_nl = true; their_no_nl = true; } | Some (filename_a, ""), None -> Some { operation = Git_ext (filename_a, filename_a, Delete_only); hunks = []; mine_no_nl = true; their_no_nl = true; } | None, Some (filename_b, b) -> diff_op (Create filename_b) "" b | Some (filename_a, a), None -> diff_op (Delete filename_a) a "" | Some (_, a), Some (_, b) when String.equal a b -> None (* NOTE: Optimization *) | Some (filename_a, a), Some (filename_b, b) -> diff_op (Edit (filename_a, filename_b)) a b patch-3.0.0/src/lib.mli0000644000175000017500000000066215031511054016250 0ustar kit_ty_katekit_ty_katemodule String : sig val is_prefix : prefix:string -> string -> bool val is_suffix : suffix:string -> string -> bool val cut : char -> string -> (string * string) option val cuts : char -> string -> string list val slice : ?start:int -> ?stop:int -> string -> string val count_common_suffix : string -> string -> int end module List : sig val last : 'a list -> 'a val rev_cut : int -> 'a list -> 'a list * 'a list end patch-3.0.0/src/lib.ml0000644000175000017500000000320415031511054016072 0ustar kit_ty_katekit_ty_katemodule String = struct let is_prefix ~prefix str = let pl = String.length prefix in if String.length str < pl then false else String.sub str 0 (String.length prefix) = prefix let is_suffix ~suffix str = let pl = String.length suffix in if String.length str < pl then false else String.sub str (String.length str - pl) pl = suffix let cut sep str = try let idx = String.index str sep and l = String.length str in let sidx = succ idx in Some (String.sub str 0 idx, String.sub str sidx (l - sidx)) with Not_found -> None let cuts sep str = let rec doit acc s = match cut sep s with | None -> List.rev (s :: acc) | Some (a, b) -> doit (a :: acc) b in doit [] str let slice ?(start = 0) ?stop str = let stop = match stop with | None -> String.length str | Some x -> x in let len = stop - start in String.sub str start len let count_common_suffix x y = let rec loop ~x ~y acc ix iy = if ix >= 0 && iy >= 0 && String.unsafe_get x ix = (String.unsafe_get y iy : char) then loop ~x ~y (acc + 1) (ix - 1) (iy - 1) else acc in let len_x = String.length x in let len_y = String.length y in loop ~x ~y 0 (len_x - 1) (len_y - 1) end module List = struct let rec last = function | [] -> invalid_arg "List.last" | [x] -> x | _::xs -> last xs let rev_cut idx l = let rec aux acc idx = function | l when idx = 0 -> (acc, l) | [] -> invalid_arg "List.cut" | x::xs -> aux (x :: acc) (idx - 1) xs in aux [] idx l end patch-3.0.0/src/fname.mli0000644000175000017500000000145415031511054016570 0ustar kit_ty_katekit_ty_kateval parse : string -> (string option, string) result (** [parse s] parses [s] and returns a filename or [None] if the filename is equivalent to [/dev/null]. Returns [Error msg] in case of error. *) (** {1 Git header parsers} *) val parse_git_header_rename : from_:string -> to_:string -> string -> (string * string) option (** [parse_git_header_rename ~from_ ~to_ str] will parse [str] by trying to match [from_] and [to_] on the left side and right side of the space split respectively. Returns [None] if nothing was able to be found. *) val parse_git_header_same : string -> (string * string) option (** [parse_git_header_same str] will parse [str] by trying to get the largest equal suffix for both filenames in the git header. Returns [None] if nothing was able to be found. *) patch-3.0.0/src/fname.ml0000644000175000017500000001127515031511054016421 0ustar kit_ty_katekit_ty_katetype lexer_output = | Quoted of (string * string) | Unquoted | Error of string exception Cant_parse_octal let ascii_zero = 48 (* Char.code '0' *) let octal_to_char c1 c2 c3 = let char_to_digit c = Char.code c - ascii_zero in try Char.chr ( (char_to_digit c1 lsl 6) lor (char_to_digit c2 lsl 3) lor char_to_digit c3 ) with Invalid_argument _ -> raise Cant_parse_octal let lex_quoted_char s len i = match s.[i] with | 'a' -> Some ('\007', 2) | 'b' -> Some ('\b', 2) | 'f' -> Some ('\012', 2) | 'n' -> Some ('\n', 2) | 'r' -> Some ('\r', 2) | 't' -> Some ('\t', 2) | 'v' -> Some ('\011', 2) | '\\' -> Some ('\\', 2) | '"' -> Some ('"', 2) | '0'..'3' as c1 when len >= 3 -> begin match s.[i + 1], s.[i + 2] with | ('0'..'7' as c2), ('0'..'7' as c3) -> (try Some (octal_to_char c1 c2 c3, 4) with Cant_parse_octal -> None) | _, _ -> None end | _ -> None let rec lex_quoted_filename buf s len i = if len > 0 then match s.[i] with | '"' -> Quoted (Buffer.contents buf, Lib.String.slice ~start:(i + 1) s) | '\\' when len > 2 -> let char_size = match lex_quoted_char s (len - 1) (i + 1) with | Some (c, char_size) -> Buffer.add_char buf c; char_size | None -> Buffer.add_char buf s.[i]; 1 in lex_quoted_filename buf s (len - char_size) (i + char_size) | c -> Buffer.add_char buf c; lex_quoted_filename buf s (len - 1) (i + 1) else Unquoted let lex_filename buf s len = if len > 0 then match s.[0] with | '"' -> lex_quoted_filename buf s (len - 1) 1 | _ -> Unquoted else Error "empty filename" let parse_filename ~allow_space s = match lex_filename (Buffer.create 128) s (String.length s) with | Quoted x -> Ok x | Unquoted when not allow_space -> begin match Lib.String.cut ' ' s with | None -> Ok (s, "") | Some x -> Ok x end | Unquoted -> Ok (s, "") | Error msg -> Error msg let parse s = let filename_and_date = match Lib.String.cut '\t' s with | None -> parse_filename ~allow_space:false s | Some (filename, date) -> match parse_filename ~allow_space:true filename with | Ok (filename, "") -> Ok (filename, date) | Ok _ -> Error "Unexpected character after closing double-quote" | Error _ as err -> err in match filename_and_date with | Ok (filename, date) -> if filename = "/dev/null" || let date = String.trim date in Lib.String.is_prefix ~prefix:"1970-" date || Lib.String.is_prefix ~prefix:"1969-" date || Lib.String.is_suffix ~suffix:" 1970" date || Lib.String.is_suffix ~suffix:" 1969" date then (* See https://github.com/hannesm/patch/issues/8 *) Ok None else Ok (Some filename) | Error _ as err -> err let parse_git_filename s = match parse_filename ~allow_space:true s with | Ok (s, "") -> Ok s | Ok _ -> Error "Unexpected character after closing double-quote in header" | Error _ as err -> err let parse_git_header_rename ~from_ ~to_ s = let rec loop ~s ~len i = if i < (len : int) then match String.unsafe_get s i with | ' ' | '\t' -> let a = parse_git_filename (Lib.String.slice ~stop:i s) in let b = parse_git_filename (Lib.String.slice ~start:(i + 1) s) in begin match a, b with | Ok a, Ok b when Lib.String.is_suffix ~suffix:from_ a && Lib.String.is_suffix ~suffix:to_ b -> Some (a, b) | Ok _, Ok _ | Error _, _ | _, Error _ -> loop ~s ~len (i + 1) end | _ -> loop ~s ~len (i + 1) else None in loop ~s ~len:(String.length s) 0 let parse_git_header_same s = let rec loop ~best ~s ~len i = if i < (len : int) then match String.unsafe_get s i with | ' ' | '\t' -> let a = parse_git_filename (Lib.String.slice ~stop:i s) in let b = parse_git_filename (Lib.String.slice ~start:(i + 1) s) in begin match a, b with | Ok a, Ok b -> begin match best, Lib.String.count_common_suffix a b with | None, best -> loop ~best:(Some (best, a, b)) ~s ~len (i + 1) | Some (prev_best, _, _), best when best > (prev_best : int) -> loop ~best:(Some (best, a, b)) ~s ~len (i + 1) | Some _ as best, _ -> loop ~best ~s ~len (i + 1) end | Error _, _ | _, Error _ -> loop ~best ~s ~len (i + 1) end | _ -> loop ~best ~s ~len (i + 1) else match best with | None -> None | Some (_best, a, b) -> Some (a, b) in loop ~best:None ~s ~len:(String.length s) 0 patch-3.0.0/src/dune0000644000175000017500000000027415031511054015654 0ustar kit_ty_katekit_ty_kate(library (name patch) (synopsis "Patch purely in OCaml") (public_name patch) (modules patch lib fname)) (executable (name patch_command) (modules patch_command) (libraries patch)) patch-3.0.0/patch.opam0000644000175000017500000000146615031511054016170 0ustar kit_ty_katekit_ty_kateopam-version: "2.0" version: "3.0.0" maintainer: "Hannes Mehnert " authors: [ "Hannes Mehnert " "Kate " ] homepage: "https://github.com/hannesm/patch" doc: "https://hannesm.github.io/patch/" dev-repo: "git+https://github.com/hannesm/patch.git" bug-reports: "https://github.com/hannesm/patch/issues" license: "ISC" depends: [ "ocaml" {>= "4.08"} "dune" {>= "3.0"} "alcotest" {with-test & >= "1.7.0"} "crowbar" {with-test} ] build: [ ["dune" "subst"] {dev} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] synopsis: "Patch library purely in OCaml" description: """ This is a library which parses unified diff and git diff output, and can apply a patch in memory. """ x-maintenance-intent: [ "(latest)" ] patch-3.0.0/dune-project0000644000175000017500000000015215031511054016524 0ustar kit_ty_katekit_ty_kate(lang dune 3.0) (name patch) (version 3.0.0) (executables_implicit_empty_intf true) (formatting disabled) patch-3.0.0/README.md0000644000175000017500000000662615031511054015475 0ustar kit_ty_katekit_ty_kate## Patch - apply your unified diffs in pure OCaml The loosely specified `diff` file format is widely used for transmitting differences of line-based information. The motivating example is [`opam`](https://opam.ocaml.org), which is able to validate updates being cryptographically signed (e.g. [conex](https://github.com/hannesm/conex)) by providing a unified diff. The [test-based infered specification](https://www.artima.com/weblogs/viewpost.jsp?thread=164293) implemented in this library is the following grammar. ``` decimal := [0-9]+ any := any character except newline filename := "/dev/null" | any except tab character file := filename "\t" any "\n" mine := "--- " file theirs := "+++ " file no_newline = "\ No newline at end of file" hunk_line_prefix := " " | "-" | "+" hunk_line := hunk_line_prefix any | no_newline range := decimal "," decimal | decimal hunk_hdr := "@@ -" range " + " range " @@\n" hunk := hunk_hdr line+ diff := mine theirs hunk+ ``` In addition, some support for the git diff format is available, which contains `diff --git a/nn b/nn` as separator, prefixes filenames with `a/` and `b/`, and may contain extra headers, especially for pure renaming: `rename from ` followed by `rename to `. The git diff documentation also mentions that a diff file itself should be an atomic operation, thus all `-` files corrspond to the files before applying the diff (since `patch` only does single diff operations, and requires the old content as input). You have to ensure to provide the correct data yourself. A `diff` consists of a two-line header containing the filenames (or "/dev/null" for creation and deletion) followed by the actual changes in hunks. A complete diff file is represented by a list of `diff` elements. The OCaml types below, provided by this library, represent mine and theirs as operation (edit, delete, create). Since a diff is line-based, if the file does not end with a newline character, the line in the diff always contains a newline, but the special marker `no_newline` is added to the diff. The `range` information carries start line and chunk size in the respective file, with two side conditions: if the chunk size is 0, the start line refers to after which the chunk should be added or deleted, and if the chunk size is omitted (including the comma), it is set to 1. NB from practical experiments, only "+1" and "-1" are supported. ```OCaml type operation = | Edit of string * string | Delete of string | Create of string | Rename_only of string * string type hunk (* positions and contents *) type t = { operation : operation ; hunks : hunk list ; mine_no_nl : bool ; their_no_nl : bool ; } ``` In addition to parsing a diff and applying it, support for generating a diff from old and new file contents is also provided. ## Shortcomings The function `patch` assumes that the patch applies cleanly, and does not check this assumption. Exceptions may be raised if this assumption is violated. The git diff format allows further features, such as file permissions, and also a "copy from / to" header, which I was unable to spot in the wild. ## Installation `opam install patch` ## Documentation The API documentation can be browsed [online](https://hannesm.github.io/patch/). ## Testsuite The testsuite can be ran with a simple `dune test`, however note that to also test larger files, you must first make sure that the submodule is up-to-date: ``` git submodule update --init ``` patch-3.0.0/LICENSE.md0000644000175000017500000000143515031511054015613 0ustar kit_ty_katekit_ty_kate(* * Copyright (c) 2019 Hannes Mehnert * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) patch-3.0.0/CHANGES.md0000644000175000017500000000607715031511054015610 0ustar kit_ty_katekit_ty_kate## v3.0.0 (2025-07-03) * No change since 3.0.0~beta1 ## v3.0.0-beta1 (2025-06-02) * Allow to use Patch.patch on large diffs with OCaml 4 (#30 @kit-ty-kate) * Patch.pp\_hunk: Fix support for printing large diffs with OCaml 4 (#30 @kit-ty-kate) * Fix Patch.diff generating malformed patch when adding a line at the end of a file that doesn't end with a newline character (#29 @kit-ty-kate) ## v3.0.0-alpha2 (2025-05-01) * Add support for large (>= MB) diffs (#23 @kit-ty-kate) * Fix printing of `Rename_only` (#23 @kit-ty-kate) * Add support for empty files through git extensions (#26 @kit-ty-kate) * Fix filename parsing of the git extensions (#26 @kit-ty-kate) * Move the `Rename_only` variant off of the `operation` type to the dedicated new `git_ext` type containing the new variants `Delete_only` and `Create_only` (#26 @kit-ty-kate) * Add a new `Git_ext` variant to the `operation` type (#26 @kit-ty-kate) * Change the type of `Patch.diff` to avoid the need to know in advance what type of operation it is gonna be (#26 @kit-ty-kate) ## v3.0.0-alpha1 (2025-03-06) * Ensure compatibility with GNU Patch as much as possible: * Fix the parsing of filenames coming from GNU or git diffs (#20 @kit-ty-kate @Leonidas-from-XIV) * Detect file creation/deletion when parsing patch files created with `diff -N` (#20 @kit-ty-kate) * Add a `~p` parameter to `Patch.parse` mimicking the behaviour of `patch -p` (#9 @kit-ty-kate @hannesm) * Allow empty lines to be equivalent to a simple newline in both mine/their (#22 @kit-ty-kate) * Allow the tab character to be used in place of ` \t` (#22 @kit-ty-kate) * `Patch.apply`: allow unclean application using the default GNU Patch algorithm (#22 @kit-ty-kate) * Allow up to 3 assumed-empty lines missing at the end of each hunk (#22 @kit-ty-kate) * Handle git extensions only when in presence of a git header (#22 @kit-ty-kate) * Add support for the empty file deletion git extension (#22 @kit-ty-kate) * Add support for spaces instead of tabs between filename and date (#22 @kit-ty-kate) * Start the diff start index from 1 (0 if empty) (#22 @kit-ty-kate) * Quote special characters from filename when pretty-printing them (#21 @kit-ty-kate) * Refuse context diffs and only accept unified diffs (#22 @kit-ty-kate) * `Patch.pp_hunk`: Add missing final end of line character (#22 @kit-ty-kate) * `Patch.pp_operation`: Print the git header when using a git extension (#22 @kit-ty-kate) ## v2.0.0 (2024-04-03) * Add support for git format-patch headers (#7 @kit-ty-kate) * Pretty-printer: fix no_newline support (#11 @kit-ty-kate) * Various fixes to the diff parser ('---' mid diff, hunks, no newline at end of file) (#10 @kit-ty-kate) * Add Patch.pp_list (#13 @kit-ty-kate) * Merge Edit and Rename operations (#14 @kit-ty-kate) * Add a diff implementation (#12 @kit-ty-kate) * Rename to_diffs to parse (#16 @kit-ty-kate) * Provide API docs, tweak documentation (@hannesm) ## v1.0.1 (2022-10-27) * Remove unnecessary bytes dependency * Fix compilation of examples * Use GitHub actions instead of travis ## v1.0.0 (2019-12-21) * Initial public release patch-3.0.0/.gitmodules0000644000175000017500000000017215031511054016361 0ustar kit_ty_katekit_ty_kate[submodule "test/data/external"] path = test/data/external url = https://codeberg.org/kit-ty-kate/ocaml-patch-tests.git patch-3.0.0/.gitignore0000644000175000017500000000004115031511054016167 0ustar kit_ty_katekit_ty_kate_build/ .merlin *.install .*.swp patch-3.0.0/.github/0000755000175000017500000000000015031511054015544 5ustar kit_ty_katekit_ty_katepatch-3.0.0/.github/workflows/0000755000175000017500000000000015031511054017601 5ustar kit_ty_katekit_ty_katepatch-3.0.0/.github/workflows/main.yml0000644000175000017500000000131315031511054021246 0ustar kit_ty_katekit_ty_katename: Main workflow on: pull_request: push: schedule: # Prime the caches every Monday - cron: 0 1 * * MON jobs: build: strategy: fail-fast: false matrix: os: - macos-latest - ubuntu-latest - windows-latest ocaml-compiler: - 4.14.x runs-on: ${{ matrix.os }} steps: - name: Checkout code uses: actions/checkout@v2 - name: Use OCaml ${{ matrix.ocaml-compiler }} uses: ocaml/setup-ocaml@v2 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} - run: opam install . --deps-only --with-test - run: opam exec -- dune build - run: opam exec -- dune runtest