From cc31862242c84ee19b41cdce94caf0c4c58cae12 Mon Sep 17 00:00:00 2001 From: Raja Boujbel Date: Tue, 5 May 2026 16:31:17 +0200 Subject: [PATCH 1/7] reftests: add test for update in repository that changes directories to files and vice versa --- master_changes.md | 1 + tests/reftests/update.test | 108 +++++++++++++++++++++++++++++++++++++ 2 files changed, 109 insertions(+) diff --git a/master_changes.md b/master_changes.md index 0e718c6c77a..0b8c5f47e79 100644 --- a/master_changes.md +++ b/master_changes.md @@ -161,6 +161,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 diff --git a/tests/reftests/update.test b/tests/reftests/update.test index 352f788fb6f..3541ae6deea 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 ><><><><><><><><><><><><><><><><><><><><><><> +[ERROR] Could not update repository "diff-repo": Change from a regular file to a directory is unsupported +# Return code 40 # +### 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-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 ><><><><><><><><><><><><><><><><><><><><><><> +[ERROR] Could not update repository "diff-repo": Change from a directory to a regular file is unsupported +# Return code 40 # +### 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-dir-file/.opam-switch/build/due.1) +-> compiled due.1 +-> installed due.1 +Done. From 9683ed67bd7c1b19a9891e53ba0e57e3678212ad Mon Sep 17 00:00:00 2001 From: Raja Boujbel Date: Tue, 28 Apr 2026 13:20:29 +0200 Subject: [PATCH 2/7] patchDiff lib test: no longer print unecessary information after patch there is no need to print 'second' directory --- master_changes.md | 1 + tests/lib/patchDiff.expected | 91 ------------------------------------ tests/lib/patchDiff.ml | 8 ++-- 3 files changed, 5 insertions(+), 95 deletions(-) diff --git a/master_changes.md b/master_changes.md index 0b8c5f47e79..14452bce6af 100644 --- a/master_changes.md +++ b/master_changes.md @@ -145,6 +145,7 @@ users) ## Internal: Windows ## Test + * lib/patchDiff: no longer print unecessary information after patch [#6915 @rjbou] ## Benchmarks * Add an even larger real-world diff to benchmark `opam update` [#6567 @kit-ty-kate] diff --git a/tests/lib/patchDiff.expected b/tests/lib/patchDiff.expected index 9d6c1bbd100..9b8f01a10e7 100644 --- a/tests/lib/patchDiff.expected +++ b/tests/lib/patchDiff.expected @@ -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 ---------------------- @@ -323,11 +283,6 @@ ERROR: Symlinks are unsupported > foo + first/same-file > foo -+ second/ -+ second/hardlinked-file-fst - > foo -+ second/same-file - > foo ---------------------- @@ -377,11 +332,6 @@ patch format > foo + first/same-file > foo -+ second/ -+ second/diff-file - > bar -+ second/same-file - > foo ---------------------- @@ -422,13 +372,6 @@ patch format > bar + first/same-file > foo -+ second/ -+ second/diff-file - > bar -+ second/diff-file-plus-fst - > foo -+ second/same-file - > foo ---------------------- @@ -453,10 +396,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 +407,6 @@ index c0ffee..c0ffee + first/im-empty + first/same-file > foo -+ second/ -+ second/im-empty -+ second/same-file - > foo ---------------------- @@ -495,9 +430,6 @@ deleted file mode 100644 + first/ + first/same-file > foo -+ second/ -+ second/same-file - > foo *** GIT DIFF *** diff --git b/im-empty a/im-empty @@ -508,9 +440,6 @@ index c0ffee..c0ffee + first/ + first/same-file > foo -+ second/ -+ second/same-file - > foo ---------------------- @@ -547,12 +476,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 +490,6 @@ rename to inner/move-me > bar + first/same-file > foo -+ second/ -+ second/inner -+ second/inner/move-me - > bar -+ second/same-file - > foo ---------------------- @@ -609,10 +526,6 @@ rename to inner/move-me + 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 +548,4 @@ index c0ffee..c0ffee + first/ + first/same-file > foo -+ second/ -+ second/im-here -+ second/same-file - > foo diff --git a/tests/lib/patchDiff.ml b/tests/lib/patchDiff.ml index 04c6e851021..abee3a6686b 100644 --- a/tests/lib/patchDiff.ml +++ b/tests/lib/patchDiff.ml @@ -345,14 +345,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 -> @@ -388,7 +388,7 @@ 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; From 875b898fc7757ededfa19aea3d3cbebc553eab99 Mon Sep 17 00:00:00 2001 From: Kate Date: Thu, 7 May 2026 12:42:45 +0100 Subject: [PATCH 3/7] Ensure a more consistent output accross Unix and Windows platforms in the patchDiff test --- master_changes.md | 1 + tests/lib/patchDiff.ml | 29 +++++++++++++++-------------- 2 files changed, 16 insertions(+), 14 deletions(-) diff --git a/master_changes.md b/master_changes.md index 14452bce6af..f61e1f1a757 100644 --- a/master_changes.md +++ b/master_changes.md @@ -146,6 +146,7 @@ users) ## 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] ## Benchmarks * Add an even larger real-world diff to benchmark `opam update` [#6567 @kit-ty-kate] diff --git a/tests/lib/patchDiff.ml b/tests/lib/patchDiff.ml index abee3a6686b..ae6f0702a2f 100644 --- a/tests/lib/patchDiff.ml +++ b/tests/lib/patchDiff.ml @@ -205,12 +205,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 +292,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 +306,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 +315,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 +329,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-- *) @@ -367,9 +368,9 @@ let diff_patch dir setup = (OpamFilename.Base.of_string first) (OpamFilename.Base.of_string 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 @@ -392,7 +393,7 @@ let diff_patch dir setup = 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 From 7d275b86bdb3fb81063a5449b186da1f074679de Mon Sep 17 00:00:00 2001 From: Raja Boujbel Date: Tue, 28 Apr 2026 11:23:28 +0200 Subject: [PATCH 4/7] Export patch related functions to its own new module 'core/opamPatch.ml' --- doc/index.html | 2 + master_changes.md | 2 + src/core/opamFilename.ml | 4 +- src/core/opamPatch.ml | 408 +++++++++++++++++++++++++++++++++++++++ src/core/opamPatch.mli | 34 ++++ src/core/opamSystem.ml | 395 ------------------------------------- src/core/opamSystem.mli | 24 --- tests/lib/patcher.ml | 2 +- 8 files changed, 449 insertions(+), 422 deletions(-) create mode 100644 src/core/opamPatch.ml create mode 100644 src/core/opamPatch.mli 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 f61e1f1a757..0cea2ee4ae3 100644 --- a/master_changes.md +++ b/master_changes.md @@ -250,6 +250,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..ecae69bb6df --- /dev/null +++ b/src/core/opamPatch.ml @@ -0,0 +1,408 @@ +(**************************************************************************) +(* *) +(* 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 = + 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: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 + 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/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"; From 156f8601cfed05237ee0e7e783b086a727084d20 Mon Sep 17 00:00:00 2001 From: Raja Boujbel Date: Tue, 28 Apr 2026 13:08:56 +0200 Subject: [PATCH 5/7] patchdiff: add dir-file transformations tests --- master_changes.md | 1 + tests/lib/patchDiff.expected | 59 ++++++++++++++++++++++++++++++++++++ tests/lib/patchDiff.ml | 39 ++++++++++++++++++++++++ 3 files changed, 99 insertions(+) diff --git a/master_changes.md b/master_changes.md index 0cea2ee4ae3..dbc2ad8b7ee 100644 --- a/master_changes.md +++ b/master_changes.md @@ -147,6 +147,7 @@ users) ## 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] diff --git a/tests/lib/patchDiff.expected b/tests/lib/patchDiff.expected index 9b8f01a10e7..db1bb2ec011 100644 --- a/tests/lib/patchDiff.expected +++ b/tests/lib/patchDiff.expected @@ -549,3 +549,62 @@ index c0ffee..c0ffee + 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/dir-fst-file-snd + > foo ++ second/same-file + > foo + +*** DIFF *** +ERROR: Change from a directory to a regular file is unsupported + +---------------------- + 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: OpamSystem.Internal_error("Cannot remove ${BASEDIR}/first/dir-fst-file-snd (Unix.Unix_error(Unix.EISDIR, \"unlink\", \"${BASEDIR}/first/dir-fst-file-snd\")).") diff --git a/tests/lib/patchDiff.ml b/tests/lib/patchDiff.ml index ae6f0702a2f..bcf56ba85d5 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"; @@ -470,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 () = From 3ba3a7447d7cfa099b99b1194d1e07cfe5f6a47f Mon Sep 17 00:00:00 2001 From: Raja Boujbel Date: Tue, 28 Apr 2026 13:12:21 +0200 Subject: [PATCH 6/7] Rewrite 'OpamRepositoryBackend.get_diff' to abstract it over any layout It retrieves content then diff on it instead of looking to the content while doing the diff Co-authored-by: arozovyk --- master_changes.md | 1 + src/repository/opamHTTP.ml | 5 +- src/repository/opamLocal.ml | 5 +- src/repository/opamRepositoryBackend.ml | 210 +++++++++++------------ src/repository/opamRepositoryBackend.mli | 8 +- tests/lib/patchDiff.expected | 147 ++++++++++++---- tests/lib/patchDiff.ml | 6 +- tests/reftests/update.test | 16 +- 8 files changed, 232 insertions(+), 166 deletions(-) diff --git a/master_changes.md b/master_changes.md index dbc2ad8b7ee..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 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 db1bb2ec011..20b38de06f1 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/ @@ -194,7 +194,31 @@ 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 PATCH ERROR *** +ERROR: Unix.Unix_error(Unix.ENOTDIR, "lstat", "${BASEDIR}/first/file-fst-dir-snd/fst") ---------------------- Test 3: diff dir/file error @@ -214,7 +238,30 @@ 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 PATCH ERROR *** +ERROR: OpamSystem.Internal_error("Cannot remove ${BASEDIR}/first/dir-fst-file-snd (Unix.Unix_error(Unix.EISDIR, \"unlink\", \"${BASEDIR}/first/dir-fst-file-snd\")).") ---------------------- Test 4: symlink fst @@ -388,7 +435,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 *** @@ -423,7 +470,7 @@ 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 *** @@ -460,14 +507,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/ @@ -512,15 +559,15 @@ 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/ @@ -570,7 +617,41 @@ index c0ffee..c0ffee > foo *** DIFF *** -ERROR: Change from a directory to a regular file is unsupported +--- 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: OpamSystem.Internal_error("Cannot remove ${BASEDIR}/first/dir-fst-file-snd (Unix.Unix_error(Unix.EISDIR, \"unlink\", \"${BASEDIR}/first/dir-fst-file-snd\")).") ---------------------- Test 15: diff dir/file error, with content in the dir that is not removed diff --git a/tests/lib/patchDiff.ml b/tests/lib/patchDiff.ml index bcf56ba85d5..9b551572bb3 100644 --- a/tests/lib/patchDiff.ml +++ b/tests/lib/patchDiff.ml @@ -393,9 +393,9 @@ 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" (rewrite ~dir s); None | exception e -> diff --git a/tests/reftests/update.test b/tests/reftests/update.test index 3541ae6deea..7aa828e6882 100644 --- a/tests/reftests/update.test +++ b/tests/reftests/update.test @@ -971,16 +971,16 @@ Am I a file ? ### opam update diff-repo <><> Updating package repositories ><><><><><><><><><><><><><><><><><><><><><><> -[ERROR] Could not update repository "diff-repo": Change from a regular file to a directory is unsupported -# Return code 40 # +[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-file-dir/.opam-switch/build/due.1) +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. @@ -1000,16 +1000,16 @@ Am I a file ? ### opam update diff-repo <><> Updating package repositories ><><><><><><><><><><><><><><><><><><><><><><> -[ERROR] Could not update repository "diff-repo": Change from a directory to a regular file is unsupported -# Return code 40 # +[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-dir-file/.opam-switch/build/due.1) +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. From 9d244143ffec7eb0b18790b3467132b2d9979cdb Mon Sep 17 00:00:00 2001 From: Raja Boujbel Date: Tue, 28 Apr 2026 13:12:33 +0200 Subject: [PATCH 7/7] Add support for patch files renaming dirs to files and files to dirs This makes it work only if the patch file is correctly ordered. Currently the only way to produce that type of diff is through git, which does not order them correctly. Reordering can be added at a later time. --- src/core/opamPatch.ml | 160 +++++++++++++++++++++-------------- tests/lib/patchDiff.expected | 23 +++-- 2 files changed, 112 insertions(+), 71 deletions(-) diff --git a/src/core/opamPatch.ml b/src/core/opamPatch.ml index ecae69bb6df..aa6168dc8a6 100644 --- a/src/core/opamPatch.ml +++ b/src/core/opamPatch.ml @@ -325,73 +325,104 @@ let translate_patch ~dir orig corrected = 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 (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 + 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 _ -> - Option.iter (OpamSystem.write (file^".orig")) content; - OpamSystem.write (file^".rej") (Format.asprintf "%a" Patch.pp diff); + | exception _ when not allow_unclean -> 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: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 - 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 + | 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 @@ -405,4 +436,3 @@ let parse_patch ~dir ~file = 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/tests/lib/patchDiff.expected b/tests/lib/patchDiff.expected index 20b38de06f1..a7181a9d6e1 100644 --- a/tests/lib/patchDiff.expected +++ b/tests/lib/patchDiff.expected @@ -217,8 +217,14 @@ similarity index 100% rename from file-fst-dir-snd rename to file-fst-dir-snd/fst -*** GIT PATCH ERROR *** -ERROR: Unix.Unix_error(Unix.ENOTDIR, "lstat", "${BASEDIR}/first/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 @@ -260,8 +266,13 @@ similarity index 100% rename from dir-fst-file-snd/fst rename to dir-fst-file-snd -*** GIT PATCH ERROR *** -ERROR: OpamSystem.Internal_error("Cannot remove ${BASEDIR}/first/dir-fst-file-snd (Unix.Unix_error(Unix.EISDIR, \"unlink\", \"${BASEDIR}/first/dir-fst-file-snd\")).") +*** GIT PATCHED *** ++ first/ ++ first/dir-fst-file-snd + > foo ++ first/same-file + > foo + ---------------------- Test 4: symlink fst @@ -651,7 +662,7 @@ index c0ffee..c0ffee -bar *** GIT PATCH ERROR *** -ERROR: OpamSystem.Internal_error("Cannot remove ${BASEDIR}/first/dir-fst-file-snd (Unix.Unix_error(Unix.EISDIR, \"unlink\", \"${BASEDIR}/first/dir-fst-file-snd\")).") +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 @@ -688,4 +699,4 @@ index c0ffee..c0ffee -bar *** PATCH ERROR *** -ERROR: OpamSystem.Internal_error("Cannot remove ${BASEDIR}/first/dir-fst-file-snd (Unix.Unix_error(Unix.EISDIR, \"unlink\", \"${BASEDIR}/first/dir-fst-file-snd\")).") +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")