diff --git a/doc/index.html b/doc/index.html index 7dfcc5111d2..72c9beb262c 100644 --- a/doc/index.html +++ b/doc/index.html @@ -82,6 +82,8 @@

opam %{OPAMVERSION}% API and libraries documentation

Parallel execution of jobs following a directed graph opamUrl.ml URL parsing and printing, with support for our different backends +opamPatch.ml + Patch application, translation and parsing Windows support opamStubs.ml diff --git a/master_changes.md b/master_changes.md index 0e718c6c77a..e70867a7ece 100644 --- a/master_changes.md +++ b/master_changes.md @@ -53,6 +53,7 @@ users) * Compute the list of available depexts on `opam update` [#6489 @arozovyk - fix #6461] * Update depexts availability repository state cache when running `opam update --depexts` [#6489 @arozovyk - fix #6461] * Display status message while loading system package availability during `opam update` [#6489 @arozovyk - fix #6461] + * `opam update` now supports updating a repository that changed a file to a directory of the same name and vice versa [#6915 @rjbou @arozovyk - fix #3830] ## Tree @@ -145,6 +146,9 @@ users) ## Internal: Windows ## Test + * lib/patchDiff: no longer print unecessary information after patch [#6915 @rjbou] + * lib/patchDiff: Ensure a more consistent output accross Unix and Windows platforms [#6915 @kit-ty-kate] + * lib/patchdiff: add dir-file transformations tests [#6915 @rjbou] ## Benchmarks * Add an even larger real-world diff to benchmark `opam update` [#6567 @kit-ty-kate] @@ -161,6 +165,7 @@ users) * Add a test showing the behaviour of .install files containing destination filepath trying to escape their scope [#6897 @rjbou @kit-ty-kate] * Add a test showing that `opam install ./` will leave packages pinned if aborted or failed [#6922 @NathanReb] + * Add test for update in repository that changes directories to files and vice versa [#6915 @rjbou] ### Engine @@ -247,6 +252,8 @@ users) * `OpamCompat.MAP.filter_map`: was removed [#6879 @kit-ty-kate] * `OpamCompat.Map.add_to_list`: was added [#6818 @dra27] * `OpamSystem`: add `is_dir_read_only` [#6489 @rjbou] + * `OpamSystem.*patch` were moved to `OpamPatch` [#6915 @rjbou] * `OpamFilename`: add `is_dir_read_only` [#6489 @rjbou] * `OpamFilename.might_escape`: ensure / is detected as a file separator when called with `~sep:Unspecified` on Windows [#6897 @kit-ty-kate] * `OpamFilename.Unix` was added abstracting over `/` separated paths regardless of the current system [#6914 @rjbou @kit-ty-kate] + * `OpamPatch` was added [#6915 @rjbou] diff --git a/src/core/opamFilename.ml b/src/core/opamFilename.ml index e97de1df57b..52ad322fd1e 100644 --- a/src/core/opamFilename.ml +++ b/src/core/opamFilename.ml @@ -456,14 +456,14 @@ let link ?(relative=false) ~target ~link = [@@ocaml.warning "-16"] let parse_patch ~dir patch_file = - OpamSystem.parse_patch ~dir:(Dir.to_string dir) ~file:(to_string patch_file) + OpamPatch.parse_patch ~dir:(Dir.to_string dir) ~file:(to_string patch_file) let patch ~allow_unclean patch_source dir = let operations_result diffs = Ok (List.map (fun d -> d.Patch.operation) diffs) in let patch ?patch_filename diffs = - OpamSystem.patch ~allow_unclean ?patch_filename ~dir:(Dir.to_string dir) + OpamPatch.patch ~allow_unclean ?patch_filename ~dir:(Dir.to_string dir) diffs in try diff --git a/src/core/opamPatch.ml b/src/core/opamPatch.ml new file mode 100644 index 00000000000..aa6168dc8a6 --- /dev/null +++ b/src/core/opamPatch.ml @@ -0,0 +1,438 @@ +(**************************************************************************) +(* *) +(* Copyright 2018 David Allsopp Ltd. *) +(* Copyright 2025 Kate Deplaix *) +(* Copyright 2026 OCamlPro *) +(* *) +(* All rights reserved. This file is distributed under the terms of the *) +(* GNU Lesser General Public License version 2.1, with the special *) +(* exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +let log ?level fmt = OpamConsole.log "PATCH" ?level fmt + +let translate_patch ~dir orig corrected = + (* It's unnecessarily complicated to infer whether the entire file is CRLF + encoded and also the status of individual files, so accept scanning the + file three times instead of two. *) + let strip_cr = OpamSystem.get_eol_encoding orig = Some true in + let ch = + try open_in_bin orig + with Sys_error _ -> raise (OpamSystem.File_not_found orig) + in + (* CRLF detection with patching can be more complicated than that used here, + especially in the presence of files with mixed LF/CRLF endings. The + processing done here aims to allow patching to succeed on files which are + wholly encoded CRLF or LF against patches which may have been translated to + be the opposite. + + The resulting patch will *always* have LF line endings for the patch + metadata (headers, chunk locations, etc.) but uses either CRLF or LF + depending on the target file. Endings in the patch are always preserved for + new files. The benefit of always using LF endings for the metadata is that + patch's "Stripping trailing CRs from patch" behaviour won't be triggered. + + There are various patch formats, though only the Unified and Context + formats allow multiple files to be patched. I tired of trying to get + sufficient documented detail of Context diffs to be able to parse them + without resorting to reverse-engineering code. It is unusual to see them + these days, so for now opam just emits a warning if a Context diff file is + encountered and does no processing to it. + + There are various semantic aspects of Unified diffs which are not handled + (at least at present) by this function which are documented in the code + with the marker "Weakness". *) + let process_chunk_header result line = + match OpamStd.String.split line ' ' with + | "@@"::a::b::"@@"::_ -> + (* Weakness: for a new file [a] should always be -0,0 (not checked) *) + let l_a = String.length a in + let l_b = String.length b in + if l_a > 1 && l_b > 1 && a.[0] = '-' && b.[0] = '+' then + try + let f (_, v) = int_of_string v in + let neg = + OpamStd.String.cut_at (String.sub a 1 (l_a - 1)) ',' + |> OpamStd.Option.map_default f 1 + in + let pos = + OpamStd.String.cut_at (String.sub b 1 (l_b - 1)) ',' + |> OpamStd.Option.map_default f 1 + in + result neg pos + with e -> + OpamStd.Exn.fatal e; + (* TODO Should display some kind of re-sync warning *) + `Header + else + (* TODO Should display some kind of re-sync warning *) + `Header + | _ -> + (* TODO Should display some kind of warning that there were no chunks *) + `Header + in + let process_state_transition next_state state transforms = + match (state, next_state) with + | (`Processing _, `Processing _) -> + transforms + | (`Processing (_, target, crlf, patch_crlf, chunks, _), _) -> + let compute_transform patch_crlf = + (* Emit the patch *) + let transform = + match (crlf, patch_crlf) with + | (None, _) + | (_, None) -> + log ~level:3 "CRLF adaptation skipped for %s" target; + None + | (Some crlf, Some patch_crlf) -> + if crlf = patch_crlf then begin + log ~level:3 "No CRLF adaptation necessary for %s" target; + None + end else if crlf then begin + log ~level:3 "Adding \\r to patch chunks for %s" target; + Some true + end else begin + log ~level:3 "Stripping \\r to patch chunks for %s" target; + Some false + end + in + let record_transform transform = + let augment_record (first_line, last_line) = + (first_line, last_line, transform) + in + List.rev_append (List.rev_map augment_record chunks) transforms + in + OpamStd.Option.map_default record_transform transforms transform + in + OpamStd.Option.map_default compute_transform transforms patch_crlf + | _ -> + transforms + in + let rec fold_lines state n transforms = + match input_line ch with + | line -> + let line = + if strip_cr then + String.sub line 0 (String.length line - 1) + else + line + in + let length = String.length line in + let next_state = + match state with + | `Header -> + begin + match (if length > 4 then String.sub line 0 4 else "") with + | "--- " -> + (* Start of a unified diff header. *) + let file = + let file = String.sub line 4 (length - 4) in + let open OpamStd in + Option.map_default fst file (String.cut_at file '\t') + in + (* Weakness: new files are also marked with a time-stamp at + the start of the epoch, however it's localised, + making it a bit tricky to identify! New files are + also identified by their absence on disk, so this + weakness isn't particularly critical. *) + if file = "/dev/null" then + `NewHeader + else + let target = + OpamStd.String.cut_at (OpamSystem.back_to_forward file) '/' + |> OpamStd.Option.map_default snd file + |> Filename.concat dir + in + if Sys.file_exists target then + let crlf = OpamSystem.get_eol_encoding target in + `Patching (file, crlf) + else + `NewHeader + | "*** " -> + OpamConsole.warning "File %s uses context diffs which are \ + less portable; consider using unified \ + diffs" orig; + `SkipFile + | _ -> + (* Headers will contain other lines, which are ignored (e.g. + the diff command which generated the diff, or Git commit + messages) *) + `Header + end + | `NewHeader -> + if (if length > 4 then String.sub line 0 4 else "") = "+++ " then + `New + else + (* TODO Should display some kind of re-sync warning *) + `Header + | `New -> + process_chunk_header (fun neg pos -> `NewChunk (neg, pos)) + line + | `NewChunk (neg, pos) -> + (* Weakness: new files should only have + lines *) + let neg = + if line = "" || line.[0] = ' ' || line.[0] = '-' then + neg - 1 + else + neg + in + let pos = + if line = "" || line.[0] = ' ' || line.[0] = '+' then + pos - 1 + else + pos + in + if neg = 0 && pos = 0 then + `New + else + (* Weakness: there should only be one chunk for a new file *) + `NewChunk (neg, pos) + | `Patching (orig, crlf) -> + if (if length > 4 then String.sub line 0 4 else "") = "+++ " then + let file = + let file = String.sub line 4 (length - 4) in + let open OpamStd in + Option.map_default fst file (String.cut_at file '\t') + in + `Processing (orig, file, crlf, None, [], `Head) + else + `Header + | `Processing (orig, target, crlf, patch_crlf, chunks, `Head) -> + if line = "\\ No newline at end of file" then + (* If the no eol-at-eof indicator is found, never add \r to + final chunk line *) + let chunks = + match chunks with + | (a, b)::chunks -> + (a, b - 1)::chunks + | _ -> + chunks + in + `Processing (orig, target, crlf, patch_crlf, chunks, `Head) + else + process_chunk_header + (fun neg pos -> + `Processing (orig, target, crlf, patch_crlf, chunks, + `Chunk (succ n, neg, pos))) + line + | `Processing (orig, target, crlf, patch_crlf, chunks, + `Chunk (first_line, neg, pos)) -> + let neg = + if line = "" || line.[0] = ' ' || line.[0] = '-' then + neg - 1 + else + neg + in + let pos = + if line = "" || line.[0] = ' ' || line.[0] = '+' then + pos - 1 + else + pos + in + let patch_crlf = + let has_cr = (length > 0 && line.[length - 1] = '\r') in + match patch_crlf with + | None -> + Some (Some has_cr) + | Some (Some think_cr) when think_cr <> has_cr -> + log ~level:2 "Patch adaptation disabled for %s: \ + mixed endings or binary file" target; + Some None + | _ -> + patch_crlf + in + if neg = 0 && pos = 0 then + let chunks = (first_line, n)::chunks in + `Processing (orig, target, crlf, patch_crlf, chunks, `Head) + else + `Processing (orig, target, crlf, patch_crlf, chunks, + `Chunk (first_line, neg, pos)) + | `SkipFile -> + `SkipFile + in + if next_state = `SkipFile then + [] + else + process_state_transition next_state state transforms + |> fold_lines next_state (succ n) + | exception End_of_file -> + process_state_transition `Header state transforms |> List.rev + in + let transforms = fold_lines `Header 1 [] in + if transforms = [] then begin + log ~level:1 "No patch translation needed for %s -> %s" orig corrected; + OpamSystem.copy_file orig corrected + end else begin + seek_in ch 0; + log ~level:1 "Transforming patch %s to %s" orig corrected; + let ch_out = + try open_out_bin corrected + with Sys_error _ -> + close_in ch; + raise (OpamSystem.File_not_found corrected) + in + let (normal, add_cr, strip_cr) = + let strip n s = String.sub s 0 (String.length s - n) in + let id x = x in + if strip_cr then + (strip 1, id, strip 2) + else + (id, (fun s -> s ^ "\r"), strip 1) + in + if OpamConsole.debug () then begin + let log_transform (first_line, last_line, add_cr) = + let indicator = if add_cr then '+' else '-' in + log ~level:3 "Transform %d-%d %c\\r" first_line last_line indicator + in + List.iter log_transform transforms + end; + let rec fold_lines n transforms = + match input_line ch with + | line -> + let (f, transforms) = + match transforms with + | (first_line, last_line, add_cr_to_chunks)::next_transforms -> + let transforms = + if n = last_line then + next_transforms + else + transforms + in + let f = + if n >= first_line then + if add_cr_to_chunks then + add_cr + else + strip_cr + else + normal + in + (f, transforms) + | [] -> + (normal, []) + in + output_string ch_out (f line); + output_char ch_out '\n'; + fold_lines (succ n) transforms + | exception End_of_file -> + close_out ch_out + in + fold_lines 1 transforms + end; + close_in ch + +exception Internal_patch_error of string + +let patch ~allow_unclean ?patch_filename ~dir diffs = + if diffs = [] then () else + let internal_patch_error fmt = + Printf.ksprintf (fun str -> raise (Internal_patch_error str)) fmt + in + let patch_info_path = + OpamStd.Option.default ("in directory "^dir) patch_filename + in + (* NOTE: It is important to keep this `concat dir ""` to ensure the + is_prefix_of below doesn't match another similarly named directory *) + let dir = Filename.concat (OpamSystem.real_path dir) "" in + let get_path file = + let file = OpamSystem.real_path (Filename.concat dir file) in + if not (OpamStd.String.is_prefix_of ~from:0 ~full:file dir) then + internal_patch_error "Patch %S tried to escape its scope." + patch_info_path; + file + in + let patch ~file content diff = + (* NOTE: The None case returned by [Patch.patch] is only returned + if [diff = Patch.Delete _]. This sub-function is not called in + this case so we [assert false] instead. *) + match Patch.patch ~cleanly:true content diff with + | Some x -> x + | None -> assert false (* See NOTE above *) + | exception _ when not allow_unclean -> + internal_patch_error "Patch %S does not apply cleanly." + patch_info_path + | exception _ -> + match Patch.patch ~cleanly:false content diff with + | Some x -> + Option.iter (OpamSystem.write (file^".orig")) content; + x + | None -> assert false (* See NOTE above *) + | exception _ -> + Option.iter (OpamSystem.write (file^".orig")) content; + OpamSystem.write (file^".rej") (Format.asprintf "%a" Patch.pp diff); + internal_patch_error "Patch %S does not apply cleanly." + patch_info_path + in + let apply diff = + match diff.Patch.operation with + | Patch.Edit (file1, file2) -> + let file1 = get_path file1 in + let file2 = get_path file2 in + let file1_exists = Sys.file_exists file1 in + (* That seems to be the GNU patch behaviour *) + let file = if file1_exists then file1 else file2 in + let content = OpamSystem.read file in + let content = patch ~file (Some content) diff in + OpamSystem.write file content; + if file1_exists && file1 <> (file2 : string) then + OpamSystem.rmdir_cleanup (Filename.dirname file1) + | Patch.Delete file | Patch.Git_ext (file, _, Patch.Delete_only) -> + let file = get_path file in + OpamSystem.remove_file file; + OpamSystem.rmdir_cleanup (Filename.dirname file) + | Patch.Create file | Patch.Git_ext (_, file, Patch.Create_only) -> + let file = get_path file in + let content = patch ~file None diff in + OpamSystem.write file content + | Patch.Git_ext (_, _, Patch.Rename_only (src, dst)) -> + let src = get_path src in + let dst = get_path dst in + let check_and_write_dst longest_path content = + let dir = Filename.dirname longest_path in + if Sys.file_exists dir && Sys.is_directory dir then + (OpamSystem.write src content; + failwith + (Printf.sprintf "Directory of %s is not empty, \ + failed to remove to write %s" + src dst)) + else + OpamSystem.write dst content + in + let contained_in ~prefix ~inn = + (* NOTE: It is important to keep this `concat prefix ""` to ensure + starts_with doesn't match another similarly named directory *) + let prefix = Filename.concat prefix "" in + OpamCompat.String.starts_with ~prefix:prefix inn + in + (* case a/b/FILE -> a/b/FILE/anotherfile *) + if contained_in ~prefix:src ~inn:dst then + let content = OpamSystem.read src in + OpamSystem.remove_file src; + check_and_write_dst dst content + (* case a/b/FILE/anotherfile -> a/b/FILE *) + else if contained_in ~prefix:dst ~inn:src then + let content = OpamSystem.read src in + OpamSystem.remove_file src; + OpamSystem.rmdir_cleanup (Filename.dirname src); + check_and_write_dst src content + else + (OpamSystem.mv src dst; + let dirname_src = Filename.dirname src in + if dirname_src <> (Filename.dirname dst : string) then + OpamSystem.rmdir_cleanup dirname_src) + in + List.iter apply diffs + +let parse_patch ~dir ~file = + if not (Sys.file_exists file) then + (OpamConsole.error "Patch file %S not found." file; + raise Not_found); + let file' = + let file' = OpamSystem.temp_file ~auto_clean:false "processed-patch" in + translate_patch ~dir file file'; + file' + in + let content = OpamSystem.read file' in + Fun.protect (fun () -> Patch.parse ~p:1 content) + ~finally:(fun () -> if not (OpamConsole.debug ()) then Sys.remove file') diff --git a/src/core/opamPatch.mli b/src/core/opamPatch.mli new file mode 100644 index 00000000000..99dd6cd78f5 --- /dev/null +++ b/src/core/opamPatch.mli @@ -0,0 +1,34 @@ +(**************************************************************************) +(* *) +(* Copyright 2026 OCamlPro *) +(* *) +(* All rights reserved. This file is distributed under the terms of the *) +(* GNU Lesser General Public License version 2.1, with the special *) +(* exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** [translate_patch ~dir input_patch output_patch] writes a copy of + [input_patch] to [output_patch] as though [input_patch] had been applied in + [dir]. The patch is rewritten such that if text files have different line + endings then the patch is transformed to patch using the encoding on disk. + In particular, this means that patches generated against Unix checkouts of + Git sources will correctly apply to Windows checkouts of the same sources. +*) +val translate_patch: dir:string -> string -> string -> unit + +(** [patch ~allow_unclean ?patch_filename ~dir diffs] applies a patch to + directory [dir]. + + @param allow_unclean decides if applying a patch on a directory which + differs slightly from the one described in the patch file is allowed. + Allowing unclean applications imitates the default behaviour of GNU Patch. *) +val patch: + allow_unclean:bool -> ?patch_filename:string -> dir:string + -> Patch.t list -> unit + + +(** [parse_patch ~dir patch_file] processes and parses a patch file. + Returns the parsed patch diffs or raises [Not_found] if the patch file + doesn't exist or can't be parsed. *) +val parse_patch: dir:string -> file:string -> Patch.t list diff --git a/src/core/opamSystem.ml b/src/core/opamSystem.ml index 0ea1e783a9a..5863a86d22b 100644 --- a/src/core/opamSystem.ml +++ b/src/core/opamSystem.ml @@ -1290,401 +1290,6 @@ let get_eol_encoding file = close_in ch; None -let translate_patch ~dir orig corrected = - (* It's unnecessarily complicated to infer whether the entire file is CRLF - encoded and also the status of individual files, so accept scanning the - file three times instead of two. *) - let log ?level fmt = OpamConsole.log "PATCH" ?level fmt in - let strip_cr = get_eol_encoding orig = Some true in - let ch = - try open_in_bin orig - with Sys_error _ -> raise (File_not_found orig) - in - (* CRLF detection with patching can be more complicated than that used here, - especially in the presence of files with mixed LF/CRLF endings. The - processing done here aims to allow patching to succeed on files which are - wholly encoded CRLF or LF against patches which may have been translated to - be the opposite. - - The resulting patch will *always* have LF line endings for the patch - metadata (headers, chunk locations, etc.) but uses either CRLF or LF - depending on the target file. Endings in the patch are always preserved for - new files. The benefit of always using LF endings for the metadata is that - patch's "Stripping trailing CRs from patch" behaviour won't be triggered. - - There are various patch formats, though only the Unified and Context - formats allow multiple files to be patched. I tired of trying to get - sufficient documented detail of Context diffs to be able to parse them - without resorting to reverse-engineering code. It is unusual to see them - these days, so for now opam just emits a warning if a Context diff file is - encountered and does no processing to it. - - There are various semantic aspects of Unified diffs which are not handled - (at least at present) by this function which are documented in the code - with the marker "Weakness". *) - let process_chunk_header result line = - match OpamStd.String.split line ' ' with - | "@@"::a::b::"@@"::_ -> - (* Weakness: for a new file [a] should always be -0,0 (not checked) *) - let l_a = String.length a in - let l_b = String.length b in - if l_a > 1 && l_b > 1 && a.[0] = '-' && b.[0] = '+' then - try - let f (_, v) = int_of_string v in - let neg = - OpamStd.String.cut_at (String.sub a 1 (l_a - 1)) ',' - |> OpamStd.Option.map_default f 1 - in - let pos = - OpamStd.String.cut_at (String.sub b 1 (l_b - 1)) ',' - |> OpamStd.Option.map_default f 1 - in - result neg pos - with e -> - OpamStd.Exn.fatal e; - (* TODO Should display some kind of re-sync warning *) - `Header - else - (* TODO Should display some kind of re-sync warning *) - `Header - | _ -> - (* TODO Should display some kind of warning that there were no chunks *) - `Header - in - let process_state_transition next_state state transforms = - match (state, next_state) with - | (`Processing _, `Processing _) -> - transforms - | (`Processing (_, target, crlf, patch_crlf, chunks, _), _) -> - let compute_transform patch_crlf = - (* Emit the patch *) - let transform = - match (crlf, patch_crlf) with - | (None, _) - | (_, None) -> - log ~level:3 "CRLF adaptation skipped for %s" target; - None - | (Some crlf, Some patch_crlf) -> - if crlf = patch_crlf then begin - log ~level:3 "No CRLF adaptation necessary for %s" target; - None - end else if crlf then begin - log ~level:3 "Adding \\r to patch chunks for %s" target; - Some true - end else begin - log ~level:3 "Stripping \\r to patch chunks for %s" target; - Some false - end - in - let record_transform transform = - let augment_record (first_line, last_line) = - (first_line, last_line, transform) - in - List.rev_append (List.rev_map augment_record chunks) transforms - in - OpamStd.Option.map_default record_transform transforms transform - in - OpamStd.Option.map_default compute_transform transforms patch_crlf - | _ -> - transforms - in - let rec fold_lines state n transforms = - match input_line ch with - | line -> - let line = - if strip_cr then - String.sub line 0 (String.length line - 1) - else - line - in - let length = String.length line in - let next_state = - match state with - | `Header -> - begin - match (if length > 4 then String.sub line 0 4 else "") with - | "--- " -> - (* Start of a unified diff header. *) - let file = - let file = String.sub line 4 (length - 4) in - let open OpamStd in - Option.map_default fst file (String.cut_at file '\t') - in - (* Weakness: new files are also marked with a time-stamp at - the start of the epoch, however it's localised, - making it a bit tricky to identify! New files are - also identified by their absence on disk, so this - weakness isn't particularly critical. *) - if file = "/dev/null" then - `NewHeader - else - let target = - OpamStd.String.cut_at (back_to_forward file) '/' - |> OpamStd.Option.map_default snd file - |> Filename.concat dir - in - if Sys.file_exists target then - let crlf = get_eol_encoding target in - `Patching (file, crlf) - else - `NewHeader - | "*** " -> - OpamConsole.warning "File %s uses context diffs which are \ - less portable; consider using unified \ - diffs" orig; - `SkipFile - | _ -> - (* Headers will contain other lines, which are ignored (e.g. - the diff command which generated the diff, or Git commit - messages) *) - `Header - end - | `NewHeader -> - if (if length > 4 then String.sub line 0 4 else "") = "+++ " then - `New - else - (* TODO Should display some kind of re-sync warning *) - `Header - | `New -> - process_chunk_header (fun neg pos -> `NewChunk (neg, pos)) - line - | `NewChunk (neg, pos) -> - (* Weakness: new files should only have + lines *) - let neg = - if line = "" || line.[0] = ' ' || line.[0] = '-' then - neg - 1 - else - neg - in - let pos = - if line = "" || line.[0] = ' ' || line.[0] = '+' then - pos - 1 - else - pos - in - if neg = 0 && pos = 0 then - `New - else - (* Weakness: there should only be one chunk for a new file *) - `NewChunk (neg, pos) - | `Patching (orig, crlf) -> - if (if length > 4 then String.sub line 0 4 else "") = "+++ " then - let file = - let file = String.sub line 4 (length - 4) in - let open OpamStd in - Option.map_default fst file (String.cut_at file '\t') - in - `Processing (orig, file, crlf, None, [], `Head) - else - `Header - | `Processing (orig, target, crlf, patch_crlf, chunks, `Head) -> - if line = "\\ No newline at end of file" then - (* If the no eol-at-eof indicator is found, never add \r to - final chunk line *) - let chunks = - match chunks with - | (a, b)::chunks -> - (a, b - 1)::chunks - | _ -> - chunks - in - `Processing (orig, target, crlf, patch_crlf, chunks, `Head) - else - process_chunk_header - (fun neg pos -> - `Processing (orig, target, crlf, patch_crlf, chunks, - `Chunk (succ n, neg, pos))) - line - | `Processing (orig, target, crlf, patch_crlf, chunks, - `Chunk (first_line, neg, pos)) -> - let neg = - if line = "" || line.[0] = ' ' || line.[0] = '-' then - neg - 1 - else - neg - in - let pos = - if line = "" || line.[0] = ' ' || line.[0] = '+' then - pos - 1 - else - pos - in - let patch_crlf = - let has_cr = (length > 0 && line.[length - 1] = '\r') in - match patch_crlf with - | None -> - Some (Some has_cr) - | Some (Some think_cr) when think_cr <> has_cr -> - log ~level:2 "Patch adaptation disabled for %s: \ - mixed endings or binary file" target; - Some None - | _ -> - patch_crlf - in - if neg = 0 && pos = 0 then - let chunks = (first_line, n)::chunks in - `Processing (orig, target, crlf, patch_crlf, chunks, `Head) - else - `Processing (orig, target, crlf, patch_crlf, chunks, - `Chunk (first_line, neg, pos)) - | `SkipFile -> - `SkipFile - in - if next_state = `SkipFile then - [] - else - process_state_transition next_state state transforms - |> fold_lines next_state (succ n) - | exception End_of_file -> - process_state_transition `Header state transforms |> List.rev - in - let transforms = fold_lines `Header 1 [] in - if transforms = [] then begin - log ~level:1 "No patch translation needed for %s -> %s" orig corrected; - copy_file orig corrected - end else begin - seek_in ch 0; - log ~level:1 "Transforming patch %s to %s" orig corrected; - let ch_out = - try open_out_bin corrected - with Sys_error _ -> - close_in ch; - raise (File_not_found corrected) - in - let (normal, add_cr, strip_cr) = - let strip n s = String.sub s 0 (String.length s - n) in - let id x = x in - if strip_cr then - (strip 1, id, strip 2) - else - (id, (fun s -> s ^ "\r"), strip 1) - in - if OpamConsole.debug () then begin - let log_transform (first_line, last_line, add_cr) = - let indicator = if add_cr then '+' else '-' in - log ~level:3 "Transform %d-%d %c\\r" first_line last_line indicator - in - List.iter log_transform transforms - end; - let rec fold_lines n transforms = - match input_line ch with - | line -> - let (f, transforms) = - match transforms with - | (first_line, last_line, add_cr_to_chunks)::next_transforms -> - let transforms = - if n = last_line then - next_transforms - else - transforms - in - let f = - if n >= first_line then - if add_cr_to_chunks then - add_cr - else - strip_cr - else - normal - in - (f, transforms) - | [] -> - (normal, []) - in - output_string ch_out (f line); - output_char ch_out '\n'; - fold_lines (succ n) transforms - | exception End_of_file -> - close_out ch_out - in - fold_lines 1 transforms - end; - close_in ch - -exception Internal_patch_error of string - -let patch ~allow_unclean ?patch_filename ~dir diffs = - let internal_patch_error fmt = - Printf.ksprintf (fun str -> raise (Internal_patch_error str)) fmt - in - let patch_info_path = - OpamStd.Option.default ("in directory "^dir) patch_filename - in - (* NOTE: It is important to keep this `concat dir ""` to ensure the - is_prefix_of below doesn't match another similarly named directory *) - let dir = Filename.concat (real_path dir) "" in - let get_path file = - let file = real_path (Filename.concat dir file) in - if not (OpamStd.String.is_prefix_of ~from:0 ~full:file dir) then - internal_patch_error "Patch %S tried to escape its scope." - patch_info_path; - file - in - let patch ~file content diff = - (* NOTE: The None case returned by [Patch.patch] is only returned - if [diff = Patch.Delete _]. This sub-function is not called in - this case so we [assert false] instead. *) - match Patch.patch ~cleanly:true content diff with - | Some x -> x - | None -> assert false (* See NOTE above *) - | exception _ when not allow_unclean -> - internal_patch_error "Patch %S does not apply cleanly." - patch_info_path - | exception _ -> - match Patch.patch ~cleanly:false content diff with - | Some x -> - Option.iter (write (file^".orig")) content; - x - | None -> assert false (* See NOTE above *) - | exception _ -> - Option.iter (write (file^".orig")) content; - write (file^".rej") (Format.asprintf "%a" Patch.pp diff); - internal_patch_error "Patch %S does not apply cleanly." - patch_info_path - in - let apply diff = match diff.Patch.operation with - | Patch.Edit (file1, file2) -> - let file1 = get_path file1 in - let file2 = get_path file2 in - let file1_exists = Sys.file_exists file1 in - (* That seems to be the GNU patch behaviour *) - let file = if file1_exists then file1 else file2 in - let content = read file in - let content = patch ~file:file (Some content) diff in - write file content; - if file1_exists && file1 <> (file2 : string) then - rmdir_cleanup (Filename.dirname file1) - | Patch.Delete file | Patch.Git_ext (file, _, Patch.Delete_only) -> - let file = get_path file in - remove_file_t ~with_log:false file; - rmdir_cleanup (Filename.dirname file) - | Patch.Create file | Patch.Git_ext (_, file, Patch.Create_only) -> - let file = get_path file in - let content = patch ~file None diff in - write file content - | Patch.Git_ext (_, _, Patch.Rename_only (src, dst)) -> - let src = get_path src in - let dst = get_path dst in - mv src dst; - let dirname_src = Filename.dirname src in - if dirname_src <> (Filename.dirname dst : string) then - rmdir_cleanup dirname_src - in - List.iter apply diffs - -let parse_patch ~dir ~file = - if not (Sys.file_exists file) then - (OpamConsole.error "Patch file %S not found." file; - raise Not_found); - let file' = - let file' = temp_file ~auto_clean:false "processed-patch" in - translate_patch ~dir file file'; - file' - in - let content = read file' in - Fun.protect (fun () -> Patch.parse ~p:1 content) - ~finally:(fun () -> if not (OpamConsole.debug ()) then Sys.remove file') - let register_printer () = Printexc.register_printer (function | Process_error r -> Some (OpamProcess.result_summary r) diff --git a/src/core/opamSystem.mli b/src/core/opamSystem.mli index 55b7ac23f09..867a9484a78 100644 --- a/src/core/opamSystem.mli +++ b/src/core/opamSystem.mli @@ -354,36 +354,12 @@ val get_lock_fd: lock -> Unix.file_descr (** {2 Misc} *) -(** [patch ~allow_unclean ?patch_filename ~dir diffs] applies a patch to - directory [dir]. - - @param allow_unclean decides if applying a patch on a directory which - differs slightly from the one described in the patch file is allowed. - Allowing unclean applications imitates the default behaviour of GNU Patch. *) -val patch: - allow_unclean:bool -> ?patch_filename:string -> dir:string - -> Patch.t list -> unit - (** Returns the end-of-line encoding style for the given file. [None] means that either the encoding of line endings is mixed, or the file contains no line endings at all (an empty file, or a file with one line and no EOL at EOF). Otherwise it returns [Some true] if all endings are encoded CRLF. *) val get_eol_encoding : string -> bool option -(** [translate_patch ~dir input_patch output_patch] writes a copy of - [input_patch] to [output_patch] as though [input_patch] had been applied in - [dir]. The patch is rewritten such that if text files have different line - endings then the patch is transformed to patch using the encoding on disk. - In particular, this means that patches generated against Unix checkouts of - Git sources will correctly apply to Windows checkouts of the same sources. -*) -val translate_patch: dir:string -> string -> string -> unit - -(** [parse_patch ~dir patch_file] processes and parses a patch file. - Returns the parsed patch diffs or raises [Not_found] if the patch file - doesn't exist or can't be parsed. *) -val parse_patch: dir:string -> file:string -> Patch.t list - (** Create a temporary file in {i ~/.opam/logs/XXX}, if [dir] is not set. ?auto_clean controls whether the file is automatically deleted when opam terminates (default: [true]). *) diff --git a/src/repository/opamHTTP.ml b/src/repository/opamHTTP.ml index 7ca4721f380..0803d55dcde 100644 --- a/src/repository/opamHTTP.ml +++ b/src/repository/opamHTTP.ml @@ -55,10 +55,7 @@ module B = struct Done (OpamRepositoryBackend.Update_full quarantine) else OpamStd.Exn.finally finalise @@ fun () -> - OpamRepositoryBackend.get_diff - (OpamFilename.dirname_dir repo_root) - (OpamFilename.basename_dir repo_root) - (OpamFilename.basename_dir quarantine) + OpamRepositoryBackend.get_diff repo_root quarantine |> function | None -> Done OpamRepositoryBackend.Update_empty | Some patch -> Done (OpamRepositoryBackend.Update_patch patch) diff --git a/src/repository/opamLocal.ml b/src/repository/opamLocal.ml index fbbf768691d..c62850ea4a0 100644 --- a/src/repository/opamLocal.ml +++ b/src/repository/opamLocal.ml @@ -178,10 +178,7 @@ module B = struct Done (OpamRepositoryBackend.Update_full quarantine) else OpamStd.Exn.finally finalise @@ fun () -> - OpamRepositoryBackend.get_diff - (OpamFilename.dirname_dir repo_root) - (OpamFilename.basename_dir repo_root) - (OpamFilename.basename_dir quarantine) + OpamRepositoryBackend.get_diff repo_root quarantine |> function | None -> Done OpamRepositoryBackend.Update_empty | Some p -> Done (OpamRepositoryBackend.Update_patch p) diff --git a/src/repository/opamRepositoryBackend.ml b/src/repository/opamRepositoryBackend.ml index e7568ee23d2..81a21da79ee 100644 --- a/src/repository/opamRepositoryBackend.ml +++ b/src/repository/opamRepositoryBackend.ml @@ -71,122 +71,111 @@ let job_text name label = (OpamConsole.colorise `green (OpamRepositoryName.to_string name)) label) -let get_files_for_diff parent_dir dir1 dir2 = - let getfiles parent_dir dir = - let dir = Filename.concat (OpamFilename.Dir.to_string parent_dir) dir in - OpamSystem.get_files_except_vcs dir - in - match dir1, dir2 with - | None, None -> assert false - | Some dir, None -> - List.map (fun file -> (Some (dir^"/"^file), None)) - (getfiles parent_dir dir) - | None, Some dir -> - List.map (fun file -> (None, Some (dir^"/"^file))) - (getfiles parent_dir dir) - | Some dir1, Some dir2 -> - let files1 = List.fast_sort String.compare (getfiles parent_dir dir1) in - let files2 = List.fast_sort String.compare (getfiles parent_dir dir2) in - let rec aux acc files1 files2 = match files1, files2 with - | (file1::files1 as orig1), (file2::files2 as orig2) -> - let cmp = String.compare file1 file2 in - if cmp = 0 then - aux ((Some (dir1^"/"^file1), Some (dir2^"/"^file2)) :: acc) - files1 files2 - else if cmp < 0 then - aux ((Some (dir1^"/"^file1), None) :: acc) files1 orig2 - else - aux ((None, Some (dir2^"/"^file2)) :: acc) orig1 files2 - | file1::files1, [] -> - aux ((Some (dir1^"/"^file1), None) :: acc) files1 [] - | [], file2::files2 -> - aux ((None, Some (dir2^"/"^file2)) :: acc) [] files2 - | [], [] -> - acc - in - aux [] files1 files2 +(** DIFF *) -(* Serves to remove the repository suffix since the quarantine mechanism in - local and http patches causes incoherencies with vcs patches *) -let strip_repo_suffix patch = - let rm_prefix f = - match OpamStd.String.cut_at f '/' with - | None -> - log "Internal diff: failed to remove prefix of %s" f; - f - | Some (_, r) -> r - in - let operation = - match patch.Patch.operation with - | Patch.Create f -> Patch.Create (rm_prefix f) - | Patch.Delete f -> Patch.Delete (rm_prefix f) - | Patch.Edit (f1, f2) -> Patch.Edit (rm_prefix f1, rm_prefix f2) - | Patch.Git_ext (f1, f2, ext) -> - Patch.Git_ext (rm_prefix f1, rm_prefix f2, ext) +(* We put back the prefix for patch -p1 harmonisation *) +let add_prefix repo1 repo2 = + let prefix repo = + OpamFilename.basename_dir repo + |> OpamFilename.Base.to_string in - {patch with operation} + let p1 x = prefix repo1 ^ "/" ^ x in + let p2 x = prefix repo2 ^ "/" ^ x in + fun patch -> + let operation = + match patch.Patch.operation with + | Patch.Create f -> Patch.Create (p2 f) + | Patch.Delete f -> Patch.Delete (p1 f) + | Patch.Edit (f1, f2) -> Patch.Edit (p1 f1, p2 f2) + | Patch.Git_ext (f1, f2, ext) -> Patch.Git_ext (p1 f1, p2 f2, ext) + in + {patch with operation} -let get_diff parent_dir dir1 dir2 = +let get_diff repo1 repo2 = let chrono = OpamConsole.timer () in - log "diff: %a/{%a,%a}" - (slog OpamFilename.Dir.to_string) parent_dir - (slog OpamFilename.Base.to_string) dir1 - (slog OpamFilename.Base.to_string) dir2; - let readfile parent_dir file = - let real_file = - Filename.concat (OpamFilename.Dir.to_string parent_dir) file + log "diff: %a" + (fun fmt () -> + if OpamFilename.Dir.equal + (OpamFilename.dirname_dir repo1) + (OpamFilename.dirname_dir repo2) then + Format.fprintf fmt "%s/{%s,%s}" + (OpamFilename.Dir.to_string (OpamFilename.dirname_dir repo1)) + (OpamFilename.Base.to_string (OpamFilename.basename_dir repo1)) + (OpamFilename.Base.to_string (OpamFilename.basename_dir repo2)) + else + Format.fprintf fmt "%s vs %s" + (OpamFilename.Dir.to_string repo1) + (OpamFilename.Dir.to_string repo2)) + (); + let get_contents = + let read_dir_contents dir = + (* Recursively read directory contents into a string map. + Returns a map from relative file paths to their contents. *) + let rec aux acc prefix current_dir = + let entries = OpamSystem.get_files_except_vcs current_dir in + List.fold_left (fun acc entry -> + let full_path = Filename.concat current_dir entry in + let relative_path = + match prefix with + | None -> entry + | Some prefix -> prefix ^ "/" ^ entry + in + let stat = Unix.lstat full_path in + match stat.Unix.st_kind with + | Unix.S_REG -> + let content = OpamSystem.read full_path in + OpamStd.String.Map.add relative_path content acc + | Unix.S_DIR -> + aux acc (Some relative_path) full_path + | Unix.S_LNK -> failwith "Symlinks are unsupported" + | Unix.S_CHR -> failwith "Character devices are unsupported" + | Unix.S_BLK -> failwith "Block devices are unsupported" + | Unix.S_FIFO -> failwith "Named pipes are unsupported" + | Unix.S_SOCK -> failwith "Sockets are unsupported") + acc entries + in + aux OpamStd.String.Map.empty None dir in - (file, OpamSystem.read real_file) + fun dir -> + read_dir_contents (OpamFilename.Dir.to_string dir) in - let lstat_opt parent_dir = function - | None -> None - | Some file -> - let file = Filename.concat (OpamFilename.Dir.to_string parent_dir) file in - Some (Unix.lstat file) + let contents1 = get_contents repo1 in + let contents2 = get_contents repo2 in + let get_content_diffs filename contents1 content2 diffs seen = + (* Compute content diffs for a single file. + Compares [content2] (new) against [contents1] (old state map). + Adds [filename] to [seen] set and generates a diff if contents differ. + Returns updated (diffs, seen) accumulator pair *) + let seen = OpamStd.String.Set.add filename seen in + match OpamStd.String.Map.find_opt filename contents1 with + | Some content1 when String.equal content1 content2 -> + (diffs, seen) + | content1_opt -> + let content1 = Option.map (fun c -> (filename, c)) content1_opt in + let content2 = Some (filename, content2) in + match Patch.diff content1 content2 with + | None -> (diffs, seen) + | Some diff -> (diff :: diffs, seen) in - let rec aux diffs dir1 dir2 = - let files = get_files_for_diff parent_dir dir1 dir2 in - let diffs = - List.fold_left (fun diffs (file1, file2) -> - let add_to_diffs content1 content2 diffs = - match Patch.diff content1 content2 with - | None -> diffs - | Some diff -> diff :: diffs - in - match lstat_opt parent_dir file1, lstat_opt parent_dir file2 with - | Some {st_kind = S_REG; _}, None - | None, Some {st_kind = S_REG; _} - | Some {st_kind = S_REG; _}, Some {st_kind = S_REG; _} -> - let content1 = Option.map (readfile parent_dir) file1 in - let content2 = Option.map (readfile parent_dir) file2 in - add_to_diffs content1 content2 diffs - | Some {st_kind = S_DIR; _}, None | None, Some {st_kind = S_DIR; _} - | Some {st_kind = S_DIR; _}, Some {st_kind = S_DIR; _} -> - aux diffs file1 file2 - | Some {st_kind = S_DIR; _}, Some {st_kind = S_REG; _} -> - failwith "Change from a directory to a regular file is unsupported" - | Some {st_kind = S_REG; _}, Some {st_kind = S_DIR; _} -> - failwith "Change from a regular file to a directory is unsupported" - | Some {st_kind = S_LNK; _}, _ | _, Some {st_kind = S_LNK; _} -> - failwith "Symlinks are unsupported" - | Some {st_kind = S_CHR; _}, _ | _, Some {st_kind = S_CHR; _} -> - failwith "Character devices are unsupported" - | Some {st_kind = S_BLK; _}, _ | _, Some {st_kind = S_BLK; _} -> - failwith "Block devices are unsupported" - | Some {st_kind = S_FIFO; _}, _ | _, Some {st_kind = S_FIFO; _} -> - failwith "Named pipes are unsupported" - | Some {st_kind = S_SOCK; _}, _ | _, Some {st_kind = S_SOCK; _} -> - failwith "Sockets are unsupported" - | None, None -> assert false) - diffs files - in - diffs + let diffs, seen = + OpamStd.String.Map.fold + (fun filename content2 (diffs, seen) -> + get_content_diffs filename contents1 content2 diffs seen) + contents2 ([], OpamStd.String.Set.empty) + in + let diffs = + (* NOTE: putting the deletions first in the list allows us to have + a simpler implementation of OpamPatch. This might not be needed + in the future if OpamPatch supports git apply style reordering. *) + OpamStd.String.Map.fold (fun filename content diffs -> + if OpamStd.String.Set.mem filename seen then diffs + else + match Patch.diff (Some (filename, content)) None with + | None -> diffs + | Some diff -> diff :: diffs) + contents1 diffs in - match - aux [] - (Some (OpamFilename.Base.to_string dir1)) - (Some (OpamFilename.Base.to_string dir2)) - with + match diffs with | [] -> log "Internal diff (empty) done in %.2fs." (chrono ()); None @@ -195,5 +184,6 @@ let get_diff parent_dir dir1 dir2 = (slog (fun l -> string_of_int (List.length l))) diffs (chrono ()); let patch = OpamSystem.temp_file ~auto_clean:false "patch" in let patch_file = OpamFilename.of_string patch in - OpamFilename.write patch_file (Format.asprintf "%a" Patch.pp_list diffs); - Some (patch_file, List.map strip_repo_suffix diffs) + let file_diffs = List.map (add_prefix repo1 repo2) diffs in + OpamFilename.write patch_file (Format.asprintf "%a" Patch.pp_list file_diffs); + Some (patch_file, diffs) diff --git a/src/repository/opamRepositoryBackend.mli b/src/repository/opamRepositoryBackend.mli index 9b2c98d92a0..b709679b1eb 100644 --- a/src/repository/opamRepositoryBackend.mli +++ b/src/repository/opamRepositoryBackend.mli @@ -108,13 +108,13 @@ val check_digest: filename -> OpamHash.t option -> bool val job_text: repository_name -> string -> 'a OpamProcess.job -> 'a OpamProcess.job -(** [get_diff parent_dir subdir1 subdir2] computes the diff between the two - subdirs of [parent_dir], returns None if they are equal, and the - corresponding patch and the list of file-changes otherwise. +(** [get_diff dir1 dir2] computes the diff between the two directories, + returns None if they are equal, and the corresponding patch and the list of + file-changes otherwise. @raise Stdlib.Failure if an unsupported file type or comparison is detected in any of [subdir1] or [subdir2]. Unsupported file types: symlinks, character devices, block devices, named pipes, sockets. Unsupported comparison: comparison between regular files and directories. *) -val get_diff: dirname -> basename -> basename -> (filename * Patch.t list) option +val get_diff: dirname -> dirname -> (filename * Patch.t list) option diff --git a/tests/lib/patchDiff.expected b/tests/lib/patchDiff.expected index 9d6c1bbd100..a7181a9d6e1 100644 --- a/tests/lib/patchDiff.expected +++ b/tests/lib/patchDiff.expected @@ -49,12 +49,24 @@ > foo *** DIFF *** ---- first/diff-dir-plus-fst/fst -+++ second/diff-dir-plus-fst/fst +--- first/file-only-fst ++++ /dev/null +@@ -1,1 +0,0 @@ +-foo +--- first/dir-only-fst/fst ++++ /dev/null +@@ -1,1 +0,0 @@ +-foo +--- /dev/null ++++ second/file-only-snd +@@ -0,0 +1,1 @@ ++foo +--- first/diff-file-plus-snd ++++ second/diff-file-plus-snd @@ -2,0 +2,1 @@ +bar ---- first/diff-dir-plus-snd/fst -+++ second/diff-dir-plus-snd/fst +--- first/diff-file-plus-fst ++++ second/diff-file-plus-fst @@ -2,1 +2,0 @@ -bar --- first/diff-file @@ -62,26 +74,14 @@ @@ -1,1 +1,1 @@ -foo +bar ---- first/diff-file-plus-fst -+++ second/diff-file-plus-fst +--- first/diff-dir-plus-snd/fst ++++ second/diff-dir-plus-snd/fst @@ -2,1 +2,0 @@ -bar ---- first/diff-file-plus-snd -+++ second/diff-file-plus-snd +--- first/diff-dir-plus-fst/fst ++++ second/diff-dir-plus-fst/fst @@ -2,0 +2,1 @@ +bar ---- first/dir-only-fst/fst -+++ /dev/null -@@ -1,1 +0,0 @@ --foo ---- first/file-only-fst -+++ /dev/null -@@ -1,1 +0,0 @@ --foo ---- /dev/null -+++ second/file-only-snd -@@ -0,0 +1,1 @@ -+foo *** PATCHED *** + first/ @@ -104,26 +104,6 @@ + first/same-dir + first/same-file > foo -+ second/ -+ second/diff-dir-plus-fst -+ second/diff-dir-plus-fst/fst - > foo - > bar -+ second/diff-dir-plus-snd -+ second/diff-dir-plus-snd/fst - > foo -+ second/diff-file - > bar -+ second/diff-file-plus-fst - > foo -+ second/diff-file-plus-snd - > foo - > bar -+ second/file-only-snd - > foo -+ second/same-dir -+ second/same-file - > foo *** GIT DIFF *** diff --git b/diff-dir-plus-fst/fst a/diff-dir-plus-fst/fst @@ -194,26 +174,6 @@ rename to file-only-snd + first/same-dir + first/same-file > foo -+ second/ -+ second/diff-dir-plus-fst -+ second/diff-dir-plus-fst/fst - > foo - > bar -+ second/diff-dir-plus-snd -+ second/diff-dir-plus-snd/fst - > foo -+ second/diff-file - > bar -+ second/diff-file-plus-fst - > foo -+ second/diff-file-plus-snd - > foo - > bar -+ second/file-only-snd - > foo -+ second/same-dir -+ second/same-file - > foo ---------------------- @@ -234,7 +194,37 @@ rename to file-only-snd > foo *** DIFF *** -ERROR: Change from a regular file to a directory is unsupported +--- first/file-fst-dir-snd ++++ /dev/null +@@ -1,1 +0,0 @@ +-foo +--- /dev/null ++++ second/file-fst-dir-snd/fst +@@ -0,0 +1,1 @@ ++foo + +*** PATCHED *** ++ first/ ++ first/file-fst-dir-snd ++ first/file-fst-dir-snd/fst + > foo ++ first/same-file + > foo + +*** GIT DIFF *** +diff --git b/file-fst-dir-snd a/file-fst-dir-snd/fst +similarity index 100% +rename from file-fst-dir-snd +rename to file-fst-dir-snd/fst + +*** GIT PATCHED *** ++ first/ ++ first/file-fst-dir-snd ++ first/file-fst-dir-snd/fst + > foo ++ first/same-file + > foo + ---------------------- Test 3: diff dir/file error @@ -254,7 +244,35 @@ ERROR: Change from a regular file to a directory is unsupported > foo *** DIFF *** -ERROR: Change from a directory to a regular file is unsupported +--- first/dir-fst-file-snd/fst ++++ /dev/null +@@ -1,1 +0,0 @@ +-foo +--- /dev/null ++++ second/dir-fst-file-snd +@@ -0,0 +1,1 @@ ++foo + +*** PATCHED *** ++ first/ ++ first/dir-fst-file-snd + > foo ++ first/same-file + > foo + +*** GIT DIFF *** +diff --git b/dir-fst-file-snd/fst a/dir-fst-file-snd +similarity index 100% +rename from dir-fst-file-snd/fst +rename to dir-fst-file-snd + +*** GIT PATCHED *** ++ first/ ++ first/dir-fst-file-snd + > foo ++ first/same-file + > foo + ---------------------- Test 4: symlink fst @@ -323,11 +341,6 @@ ERROR: Symlinks are unsupported > foo + first/same-file > foo -+ second/ -+ second/hardlinked-file-fst - > foo -+ second/same-file - > foo ---------------------- @@ -377,11 +390,6 @@ patch format > foo + first/same-file > foo -+ second/ -+ second/diff-file - > bar -+ second/same-file - > foo ---------------------- @@ -422,13 +430,6 @@ patch format > bar + first/same-file > foo -+ second/ -+ second/diff-file - > bar -+ second/diff-file-plus-fst - > foo -+ second/same-file - > foo ---------------------- @@ -445,7 +446,7 @@ patch format > foo *** DIFF *** -diff --git second/im-empty second/im-empty +diff --git first/im-empty second/im-empty new file mode 100644 *** PATCHED *** @@ -453,10 +454,6 @@ new file mode 100644 + first/im-empty + first/same-file > foo -+ second/ -+ second/im-empty -+ second/same-file - > foo *** GIT DIFF *** diff --git b/im-empty a/im-empty @@ -468,10 +465,6 @@ index c0ffee..c0ffee + first/im-empty + first/same-file > foo -+ second/ -+ second/im-empty -+ second/same-file - > foo ---------------------- @@ -488,16 +481,13 @@ index c0ffee..c0ffee > foo *** DIFF *** -diff --git first/im-empty first/im-empty +diff --git first/im-empty second/im-empty deleted file mode 100644 *** PATCHED *** + first/ + first/same-file > foo -+ second/ -+ second/same-file - > foo *** GIT DIFF *** diff --git b/im-empty a/im-empty @@ -508,9 +498,6 @@ index c0ffee..c0ffee + first/ + first/same-file > foo -+ second/ -+ second/same-file - > foo ---------------------- @@ -531,14 +518,14 @@ index c0ffee..c0ffee > foo *** DIFF *** ---- /dev/null -+++ second/inner/move-me -@@ -0,0 +1,1 @@ -+bar --- first/move-me +++ /dev/null @@ -1,1 +0,0 @@ -bar +--- /dev/null ++++ second/inner/move-me +@@ -0,0 +1,1 @@ ++bar *** PATCHED *** + first/ @@ -547,12 +534,6 @@ index c0ffee..c0ffee > bar + first/same-file > foo -+ second/ -+ second/inner -+ second/inner/move-me - > bar -+ second/same-file - > foo *** GIT DIFF *** diff --git b/move-me a/inner/move-me @@ -567,12 +548,6 @@ rename to inner/move-me > bar + first/same-file > foo -+ second/ -+ second/inner -+ second/inner/move-me - > bar -+ second/same-file - > foo ---------------------- @@ -595,24 +570,20 @@ rename to inner/move-me > foo *** DIFF *** ---- first/im-here/delete-me -+++ /dev/null -@@ -1,1 +0,0 @@ --bar --- first/im-not-here/delete-me +++ /dev/null @@ -1,1 +0,0 @@ -baz \ No newline at end of file +--- first/im-here/delete-me ++++ /dev/null +@@ -1,1 +0,0 @@ +-bar *** PATCHED *** + first/ + first/same-file > foo -+ second/ -+ second/im-here -+ second/same-file - > foo *** GIT DIFF *** diff --git b/im-here/delete-me a/im-here/delete-me @@ -635,8 +606,97 @@ index c0ffee..c0ffee + first/ + first/same-file > foo + + +---------------------- + Test 14: diff dir/file error, with content in the dir that is removed +---------------------- + +*** SETUP *** ++ first/ ++ first/dir-fst-file-snd ++ first/dir-fst-file-snd/fst + > foo ++ first/dir-fst-file-snd/remove-me + > bar ++ first/same-file + > foo + second/ -+ second/im-here ++ second/dir-fst-file-snd + > foo + second/same-file > foo +*** DIFF *** +--- first/dir-fst-file-snd/remove-me ++++ /dev/null +@@ -1,1 +0,0 @@ +-bar +--- first/dir-fst-file-snd/fst ++++ /dev/null +@@ -1,1 +0,0 @@ +-foo +--- /dev/null ++++ second/dir-fst-file-snd +@@ -0,0 +1,1 @@ ++foo + +*** PATCHED *** ++ first/ ++ first/dir-fst-file-snd + > foo ++ first/same-file + > foo + +*** GIT DIFF *** +diff --git b/dir-fst-file-snd/fst a/dir-fst-file-snd +similarity index 100% +rename from dir-fst-file-snd/fst +rename to dir-fst-file-snd +diff --git b/dir-fst-file-snd/remove-me a/dir-fst-file-snd/remove-me +deleted file mode c0ffee +index c0ffee..c0ffee +--- b/dir-fst-file-snd/remove-me ++++ /dev/null +@@ -1 +0,0 @@ +-bar + +*** GIT PATCH ERROR *** +ERROR: Failure("Directory of ${BASEDIR}/first/dir-fst-file-snd/fst is not empty, failed to remove to write ${BASEDIR}/first/dir-fst-file-snd") + +---------------------- + Test 15: diff dir/file error, with content in the dir that is not removed +---------------------- + +*** SETUP *** ++ first/ ++ first/dir-fst-file-snd ++ first/dir-fst-file-snd/fst + > foo ++ first/dir-fst-file-snd/i-wont-be-removed + > baz ++ first/dir-fst-file-snd/remove-me + > bar ++ first/same-file + > foo ++ second/ ++ second/dir-fst-file-snd + > foo ++ second/same-file + > foo + +*** GIVEN DIFF *** +diff --git b/dir-fst-file-snd/fst a/dir-fst-file-snd +similarity index 100% +rename from dir-fst-file-snd/fst +rename to dir-fst-file-snd +diff --git b/dir-fst-file-snd/remove-me a/dir-fst-file-snd/remove-me +deleted file mode c0ffee +index c0ffee..c0ffee +--- b/dir-fst-file-snd/remove-me ++++ /dev/null +@@ -1 +0,0 @@ +-bar + +*** PATCH ERROR *** +ERROR: Failure("Directory of ${BASEDIR}/first/dir-fst-file-snd/fst is not empty, failed to remove to write ${BASEDIR}/first/dir-fst-file-snd") diff --git a/tests/lib/patchDiff.ml b/tests/lib/patchDiff.ml index 04c6e851021..9b551572bb3 100644 --- a/tests/lib/patchDiff.ml +++ b/tests/lib/patchDiff.ml @@ -97,6 +97,35 @@ let content_file_dir = [ }; ] +let content_file_dir_with_content = [ + same_file; + { name = "dir-fst-file-snd"; + first = Dir [ "fst", foo; "remove-me", bar ]; + second = File foo; + }; +] + +let content_file_dir_with_content_error = [ + same_file; + { name = "dir-fst-file-snd"; + first = Dir [ "fst", foo; "remove-me", bar; "i-wont-be-removed", "baz"]; + second = File foo; + }; +] + +let gitdiff_patch_failure_dir_non_empty = + "diff --git b/dir-fst-file-snd/fst a/dir-fst-file-snd\n" ^ + "similarity index 100%\n" ^ + "rename from dir-fst-file-snd/fst\n" ^ + "rename to dir-fst-file-snd\n" ^ + "diff --git b/dir-fst-file-snd/remove-me a/dir-fst-file-snd/remove-me\n" ^ + "deleted file mode c0ffee\n" ^ + "index c0ffee..c0ffee\n" ^ + "--- b/dir-fst-file-snd/remove-me\n" ^ + "+++ /dev/null\n" ^ + "@@ -1 +0,0 @@\n" ^ + "-bar\n" + let content_symlink_fst = [ same_file; { name = "linked-file-fst"; @@ -205,12 +234,13 @@ let content_single_file_in_dir_snd = [ (** Utils *) let print = Printf.printf -let rm_hex = - let re = - Str.regexp {|[0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f]?|} - in - let by = "c0ffee" in - fun s -> Str.global_replace re by s +let rewrite ~dir s = + let l = [ + Str.regexp_string {|\\|}, "/"; + Str.regexp_string (OpamSystem.back_to_forward (OpamFilename.Dir.to_string OpamFilename.Op.(dir / ""))), "${BASEDIR}/"; + Str.regexp {|[0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f]?|}, "c0ffee"; + ] in + List.fold_left (fun s (re, by) -> Str.global_replace re by s) s l open OpamFilename.Op let read_dir root names = @@ -291,7 +321,7 @@ let write_setup ?(only_fst=false) dir content = content (* --Git-- *) -let git_cmds repo_root commands error_msg = +let git_cmds ~dir repo_root commands error_msg = let commands = List.map (fun args -> OpamSystem.make_command "git" @@ -305,7 +335,7 @@ let git_cmds repo_root commands error_msg = | _ -> failwith (OpamProcess.string_of_command command)) commands with Failure e -> - print "ERROR:%s: %s\n" error_msg (rm_hex e) + print "ERROR:%s: %s\n" error_msg (rewrite ~dir e) let make_git_repo dir = let first_root = dir / first in @@ -314,7 +344,7 @@ let make_git_repo dir = [ "add"; "--all" ]; [ "commit"; "-qm"; "first" ]; ] in - git_cmds first_root commands "Git init" + git_cmds ~dir first_root commands "Git init" let generate_git_diff dir = let first_root = dir / first in @@ -328,9 +358,9 @@ let generate_git_diff dir = [ "-c"; "diff.noprefix=false"; "diff"; "--text"; "--no-ext-diff"; "-R"; "-p"; "HEAD..HEAD^"; "--output="^(OpamFilename.to_string name) ] ] in - git_cmds first_root commands "Git generate diff"; + git_cmds ~dir first_root commands "Git generate diff"; print "*** GIT DIFF ***\n"; - print "%s\n" (rm_hex @@ OpamFilename.read name); + print "%s\n" (rewrite ~dir (OpamFilename.read name)); name (* --Git-- *) @@ -345,14 +375,14 @@ type setup = { git: bool; (* add a test where the first directory is a git directory or not *) } -let print_dirs dir = - print "%s\n" (read_dir dir [ first; second ]) +let print_dirs dir dirs = + print "%s\n" (read_dir dir dirs) let diff_patch dir setup = let { content; kind; git; _ } = setup in write_setup dir content; print "*** SETUP ***\n"; - print_dirs dir; + print_dirs dir [first; second]; let diff = match kind with | Patch patch -> @@ -363,13 +393,13 @@ let diff_patch dir setup = | DiffPatch -> print "*** DIFF ***\n"; match - OpamRepositoryBackend.get_diff dir - (OpamFilename.Base.of_string first) - (OpamFilename.Base.of_string second) + OpamRepositoryBackend.get_diff + (dir / first) + (dir / second) with - | exception Failure s -> print "ERROR: %s\n" (rm_hex s); None + | exception Failure s -> print "ERROR: %s\n" (rewrite ~dir s); None | exception e -> - print "ERROR: %s\n" (rm_hex @@ Printexc.to_string e); + print "ERROR: %s\n" (rewrite ~dir (Printexc.to_string e)); None | None -> print "No diff\n"; None | Some (f,_) -> Some f @@ -388,11 +418,11 @@ let diff_patch dir setup = match result with | Ok _ -> print "*** %sPATCHED ***\n" git; - print_dirs dir; + print_dirs dir [first]; true | Error exn -> print "*** %sPATCH ERROR ***\n" git; - print "ERROR: %s\n" (rm_hex @@ Printexc.to_string exn); + print "ERROR: %s\n" (rewrite ~dir (Printexc.to_string exn)); false in let patched = apply ~git:false diff in @@ -469,6 +499,16 @@ let tests = [ kind = DiffPatch; git = true; }; + { label = "diff dir/file error, with content in the dir that is removed"; + content = content_file_dir_with_content; + kind = DiffPatch; + git = true; + }; + { label = "diff dir/file error, with content in the dir that is not removed"; + content = content_file_dir_with_content_error; + kind = Patch gitdiff_patch_failure_dir_non_empty; + git = false; + }; ] let () = diff --git a/tests/lib/patcher.ml b/tests/lib/patcher.ml index a2a473bb3a1..04cb4110132 100644 --- a/tests/lib/patcher.ml +++ b/tests/lib/patcher.ml @@ -76,7 +76,7 @@ let generate_patch () = flush stderr; flush stdout; if Sys.command "diff -Naur a b > input.patch" <> 1 then (Printf.eprintf "patch generation failed\n%!"; exit 2); set_debug_level (-3) ["PATCH"]; - OpamSystem.translate_patch ~dir:"c" "input.patch" "output.patch"; + OpamPatch.translate_patch ~dir:"c" "input.patch" "output.patch"; set_debug_level 0 []; OpamSystem.chdir "c"; Printf.eprintf "Before patch state of c:\n"; diff --git a/tests/reftests/update.test b/tests/reftests/update.test index 352f788fb6f..7aa828e6882 100644 --- a/tests/reftests/update.test +++ b/tests/reftests/update.test @@ -905,3 +905,111 @@ The following actions would be performed: - upgrade pkg-foo 1.0.0~alpha1 to 1.0.0~alpha2~pre0 === install 1 package - install lib-foo 1.0.0~alpha1 [required by pkg-foo] +### :V: Changes that move a file into a directory and vice versa +### +opam-version: "2.0" +### +opam-version: "2.0" +### +opam-version: "2.0" +### +Am I a file ? +### +set -eu +nv=$1 +file=$2 +n=${nv%.*} +path="DREPO/packages/$n/$nv" +md5=$(openssl md5 "$path/files/$file" | cut -d' ' -f2) +cat >> "$path/opam" << EOF +build: [ "test" "-f" "$file" ] +extra-files: [ + [ "$file" "md5=$md5" ] +] +EOF +### sh add-xf.sh due.1 archivio +### opam repo remove git-ver git-test incremental --all +### opam repo -a +# Repository # Url # Switches(rank) +### opam show pkg-foo.1.0.0~alpha1 + +<><> pkg-foo: information on all versions <><><><><><><><><><><><><><><><><><><> +name pkg-foo +all-installed-versions 1.0.0~alpha1 [git-version-switch] +all-versions 1.0.0~alpha1 + +<><> Version-specific details <><><><><><><><><><><><><><><><><><><><><><><><><> +version 1.0.0~alpha1 +### opam repo add diff-repo ./DREPO --set-default +[diff-repo] Initialised +### opam switch create update-init --empty +### opam list -A +# Packages matching: any +# Name # Installed # Synopsis +due -- +### opam install due -vv | sed-cmd test +The following actions will be performed: +=== install 1 package + - install due 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [due: test archivio] ++ test "-f" "archivio" (CWD=${BASEDIR}/OPAM/update-init/.opam-switch/build/due.1) +-> compiled due.1 +-> installed due.1 +Done. +### :V:1: Update repository with changes File -> Dir +### rm DREPO/packages/uno/uno.1 DREPO/packages/due/due.1/files/archivio +### +opam-version: "2.0" +### +opam-version: "2.0" +### +Am I a file ? +### sh add-xf.sh due.1 archivio/interno +### opam switch create update-file-dir --empty +### opam update diff-repo + +<><> Updating package repositories ><><><><><><><><><><><><><><><><><><><><><><> +[diff-repo] synchronised from file://${BASEDIR}/DREPO +Now run 'opam upgrade' to apply any package updates. +### opam install due -vv | sed-cmd test +The following actions will be performed: +=== install 1 package + - install due 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [due: test] ++ test "-f" "archivio/interno" (CWD=${BASEDIR}/OPAM/update-file-dir/.opam-switch/build/due.1) +-> compiled due.1 +-> installed due.1 +Done. +### :V:2: Update repository with changes Dir -> File +### opam repo remove diff-repo --all +### opam repo add diff-repo ./DREPO --set-default +[diff-repo] Initialised +### rm -r DREPO/packages/uno/uno.1 DREPO/packages/due/due.1/files/archivio +### +opam-version: "2.0" +### +opam-version: "2.0" +### +Am I a file ? +### sh add-xf.sh due.1 archivio +### opam switch create update-dir-file --empty +### opam update diff-repo + +<><> Updating package repositories ><><><><><><><><><><><><><><><><><><><><><><> +[diff-repo] synchronised from file://${BASEDIR}/DREPO +Now run 'opam upgrade' to apply any package updates. +### opam install due -vv | sed-cmd test +The following actions will be performed: +=== install 1 package + - install due 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [due: test archivio] ++ test "-f" "archivio" (CWD=${BASEDIR}/OPAM/update-dir-file/.opam-switch/build/due.1) +-> compiled due.1 +-> installed due.1 +Done.