From 3090e15ffc9cea81b420b7743cd373827a4d5359 Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 2 Jun 2025 01:32:54 +0100 Subject: [PATCH 1/5] Add a test showing Patch.patch and Patch.pp_hunk stackoverflowing on large diffs with OCaml 4 --- test/data/external | 2 +- test/test.ml | 20 ++++++++++++++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/test/data/external b/test/data/external index 27ee0cb..6838772 160000 --- a/test/data/external +++ b/test/data/external @@ -1 +1 @@ -Subproject commit 27ee0cb7548e650585fbe1518128155131590854 +Subproject commit 6838772a456e65ecbea999c27d5ca7c794026566 diff --git a/test/test.ml b/test/test.ml index 19efec5..67e9561 100644 --- a/test/test.ml +++ b/test/test.ml @@ -1083,10 +1083,30 @@ let parse_own () = | 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, (fun () -> Alcotest.match_raises "[Temporary] Stack overflow" (function Stack_overflow -> true | _ -> false) one_mil_print); + "1_000_000 apply", `Quick, (fun () -> Alcotest.match_raises "[Temporary] Stack overflow" (function Stack_overflow -> true | _ -> false) one_mil_apply); ] let print_diff_mine_empty_their_no_nl () = From 00800e963e8967a31ca5db0b6c3ce114e8856189 Mon Sep 17 00:00:00 2001 From: Kate Date: Thu, 29 May 2025 19:33:07 +0100 Subject: [PATCH 2/5] Patch.pp_hunk: Fix support for printing large diffs with OCaml 4 List.map and (@) were not tail-recursive so it would stack overflow --- src/patch.ml | 22 +++++++++++++++------- test/test.ml | 2 +- 2 files changed, 16 insertions(+), 8 deletions(-) diff --git a/src/patch.ml b/src/patch.ml index 4576a53..9f0d32e 100644 --- a/src/patch.ml +++ b/src/patch.ml @@ -16,15 +16,23 @@ type parse_error = { exception Parse_error of parse_error let unified_diff ~mine_no_nl ~their_no_nl hunk = - let no_nl_str = ["\\ No newline at end of file"] in - (* TODO *) - String.concat "\n" (List.map (fun line -> "-" ^ line) hunk.mine @ - (if mine_no_nl then no_nl_str else []) @ - List.map (fun line -> "+" ^ line) hunk.their @ - (if their_no_nl then no_nl_str else [])) + 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\n" + 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) diff --git a/test/test.ml b/test/test.ml index 67e9561..d02479a 100644 --- a/test/test.ml +++ b/test/test.ml @@ -1105,7 +1105,7 @@ let big_diff = [ "parse", `Quick, parse_big; "print", `Quick, print_big; "parse own", `Quick, parse_own; - "1_000_000 print", `Quick, (fun () -> Alcotest.match_raises "[Temporary] Stack overflow" (function Stack_overflow -> true | _ -> false) one_mil_print); + "1_000_000 print", `Quick, one_mil_print; "1_000_000 apply", `Quick, (fun () -> Alcotest.match_raises "[Temporary] Stack overflow" (function Stack_overflow -> true | _ -> false) one_mil_apply); ] From 223652a702c2bdbb3860f5cf4aa2a05a435c3678 Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 21 Apr 2025 22:14:36 +0100 Subject: [PATCH 3/5] speedup Patch.patch by avoiding List.append This also allows to use Patch.patch on large diffs when using OCaml 4 as (@)/List.append is not tail-recursive with OCaml 4 --- src/patch.ml | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/patch.ml b/src/patch.ml index 9f0d32e..a6432e4 100644 --- a/src/patch.ml +++ b/src/patch.ml @@ -474,23 +474,28 @@ let patch ~cleanly filedata diff = | Create _ -> begin match diff.hunks with | [ the_hunk ] -> - let d = the_hunk.their in - let lines = if diff.their_no_nl then d else d @ [""] in - Some (String.concat "\n" lines) + 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 -> (match List.rev lines with ""::tl -> List.rev tl | _ -> lines) - | true, false -> lines @ [ "" ] - | false, false when filedata = None -> lines @ [ "" ] (* TODO: i'm not sure about this *) + | 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 (String.concat "\n" lines) + Some lines let diff_op operation a b = let rec aux ~mine_start ~mine_len ~mine ~their_start ~their_len ~their l1 l2 = From 6258e519d46c07785e59c7eb19e7255277e5b04e Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 21 Apr 2025 21:06:42 +0100 Subject: [PATCH 4/5] remove unnecessary List.rev --- src/lib.ml | 8 ++++++++ src/lib.mli | 1 + src/patch.ml | 15 ++++----------- 3 files changed, 13 insertions(+), 11 deletions(-) diff --git a/src/lib.ml b/src/lib.ml index 95b496f..e9f5b7e 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -57,4 +57,12 @@ module List = struct | [] -> 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 diff --git a/src/lib.mli b/src/lib.mli index fe6d438..81da0d8 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -9,4 +9,5 @@ end module List : sig val last : 'a list -> 'a + val rev_cut : int -> 'a list -> 'a list * 'a list end diff --git a/src/patch.ml b/src/patch.ml index a6432e4..0f5e0e7 100644 --- a/src/patch.ml +++ b/src/patch.ml @@ -36,24 +36,17 @@ let pp_hunk ~mine_no_nl ~their_no_nl ppf hunk = hunk.mine_start hunk.mine_len hunk.their_start hunk.their_len (unified_diff ~mine_no_nl ~their_no_nl hunk) -let list_cut idx l = - let rec aux acc idx = function - | l when idx = 0 -> (List.rev acc, l) - | [] -> invalid_arg "list_cut" - | x::xs -> aux (x :: acc) (idx - 1) xs - in - aux [] idx l - 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 prefix, rest = list_cut (Stdlib.max 0 (mine_start - 1)) lines in - let actual_mine, suffix = list_cut mine_len rest 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), prefix @ their @ suffix) + (mine_start + mine_len, offset + (their_len - mine_len), List.rev_append rev_prefix (their @ suffix)) in try patch_match ~search_offset:0 with Invalid_argument _ -> From 14c6170a874c330b3eb6344de8b574860cb2f223 Mon Sep 17 00:00:00 2001 From: Kate Date: Thu, 29 May 2025 20:33:55 +0100 Subject: [PATCH 5/5] Allow to use Patch.patch on large diffs with OCaml 4 --- src/patch.ml | 5 ++++- test/test.ml | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/patch.ml b/src/patch.ml index 0f5e0e7..4388c64 100644 --- a/src/patch.ml +++ b/src/patch.ml @@ -46,7 +46,10 @@ let rec apply_hunk ~cleanly ~fuzz (last_matched_line, offset, lines) ({mine_star 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), List.rev_append rev_prefix (their @ suffix)) + (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 _ -> diff --git a/test/test.ml b/test/test.ml index d02479a..b392067 100644 --- a/test/test.ml +++ b/test/test.ml @@ -1106,7 +1106,7 @@ let big_diff = [ "print", `Quick, print_big; "parse own", `Quick, parse_own; "1_000_000 print", `Quick, one_mil_print; - "1_000_000 apply", `Quick, (fun () -> Alcotest.match_raises "[Temporary] Stack overflow" (function Stack_overflow -> true | _ -> false) one_mil_apply); + "1_000_000 apply", `Quick, one_mil_apply; ] let print_diff_mine_empty_their_no_nl () =