From 680da0d6b21737140558267e2dc0d933b18a4bd2 Mon Sep 17 00:00:00 2001 From: Kate Date: Fri, 11 Oct 2024 11:53:10 +0100 Subject: [PATCH 1/3] tmp --- configure | 34 ++++++- configure.ac | 2 + opam-core.opam | 1 + src/client/opamInitDefaults.ml | 4 +- src/core/dune | 2 +- src/core/opamSystem.ml | 93 ++++++++++------- src/core/opamSystem.mli | 3 + src/repository/opamRepositoryBackend.ml | 126 ++++++++++++++++++++---- src_ext/Makefile | 2 +- src_ext/Makefile.sources | 3 + tests/reftests/repository.test | 12 --- 11 files changed, 209 insertions(+), 73 deletions(-) diff --git a/configure b/configure index 10a0cd26ce9..3090867a613 100755 --- a/configure +++ b/configure @@ -622,6 +622,7 @@ ac_ct_CXX CXXFLAGS CXX OCAML_PKG_mccs +OCAML_PKG_patch OCAML_PKG_swhid_core OCAML_PKG_sha OCAML_PKG_uutf @@ -6521,6 +6522,30 @@ printf "%s\n" "not found" >&6; } + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package patch" >&5 +printf %s "checking for OCaml findlib package patch... " >&6; } + + unset found + unset pkg + found=no + for pkg in patch ; do + if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: found" >&5 +printf "%s\n" "found" >&6; } + OCAML_PKG_patch=$pkg + found=yes + break + fi + done + if test "$found" = "no" ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: not found" >&5 +printf "%s\n" "not found" >&6; } + OCAML_PKG_patch=no + fi + + + + # Optional dependencies { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package mccs 1.1+17 or later" >&5 @@ -6877,11 +6902,11 @@ if test x$ac_prog_cxx_stdcxx = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CXX option to enable C++11 features" >&5 printf %s "checking for $CXX option to enable C++11 features... " >&6; } -if test ${ac_cv_prog_cxx_11+y} +if test ${ac_cv_prog_cxx_cxx11+y} then : printf %s "(cached) " >&6 else $as_nop - ac_cv_prog_cxx_11=no + ac_cv_prog_cxx_cxx11=no ac_save_CXX=$CXX cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -6923,11 +6948,11 @@ if test x$ac_prog_cxx_stdcxx = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CXX option to enable C++98 features" >&5 printf %s "checking for $CXX option to enable C++98 features... " >&6; } -if test ${ac_cv_prog_cxx_98+y} +if test ${ac_cv_prog_cxx_cxx98+y} then : printf %s "(cached) " >&6 else $as_nop - ac_cv_prog_cxx_98=no + ac_cv_prog_cxx_cxx98=no ac_save_CXX=$CXX cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -7047,6 +7072,7 @@ if test "x${enable_checks}" != "xno" && { test "x$OCAML_PKG_uutf" = "xno" || test "x$OCAML_PKG_sha" = "xno" || test "x$OCAML_PKG_swhid_core" = "xno" || + test "x$OCAML_PKG_patch" = "xno" || test "x$OCAML_PKG_mccs$MCCS_ENABLED" = "xnotrue";} then : diff --git a/configure.ac b/configure.ac index 919416bd320..22d13216573 100644 --- a/configure.ac +++ b/configure.ac @@ -366,6 +366,7 @@ AC_CHECK_OCAML_PKG([jsonm]) AC_CHECK_OCAML_PKG([uutf]) AC_CHECK_OCAML_PKG([sha]) AC_CHECK_OCAML_PKG([swhid_core]) +AC_CHECK_OCAML_PKG([patch]) # Optional dependencies AC_CHECK_OCAML_PKG_AT_LEAST([mccs],[1.1+17]) @@ -414,6 +415,7 @@ AS_IF([test "x${enable_checks}" != "xno" && { test "x$OCAML_PKG_uutf" = "xno" || test "x$OCAML_PKG_sha" = "xno" || test "x$OCAML_PKG_swhid_core" = "xno" || + test "x$OCAML_PKG_patch" = "xno" || test "x$OCAML_PKG_mccs$MCCS_ENABLED" = "xnotrue";}],[ AS_IF([test "x${with_vendored_deps}" != "xyes"],[ AC_MSG_ERROR([Dependencies missing. Use --with-vendored-deps or --disable-checks]) diff --git a/opam-core.opam b/opam-core.opam index e9ab6da90b8..36fc1b7473b 100644 --- a/opam-core.opam +++ b/opam-core.opam @@ -30,6 +30,7 @@ depends: [ "sha" {>= "1.13"} "jsonm" "swhid_core" + "patch" {>= "1.0.1"} "uutf" (("host-system-mingw" {os = "win32" & os-distribution != "cygwinports"} & "conf-mingw-w64-gcc-i686" {os = "win32" & os-distribution != "cygwinports"} & diff --git a/src/client/opamInitDefaults.ml b/src/client/opamInitDefaults.ml index 6b5a7017fbf..a90267f8d0c 100644 --- a/src/client/opamInitDefaults.ml +++ b/src/client/opamInitDefaults.ml @@ -133,7 +133,6 @@ let recommended_tools () = let required_tools ~sandboxing () = req_dl_tools () @ [ - ["diff"], None, None; ["patch"], None, Some patch_filter; ["gpatch"], None, Some gpatch_filter; ["tar"], None, Some tar_filter; @@ -148,7 +147,8 @@ let required_tools ~sandboxing () = let required_packages_for_cygwin = [ - "diffutils"; + "diffutils"; (* TODO: not used internally anymore but used by many packages *) + "git"; (* XXX hg & mercurial ? *) "make"; "patch"; "tar"; diff --git a/src/core/dune b/src/core/dune index 723aa44aaab..76e442c5be9 100644 --- a/src/core/dune +++ b/src/core/dune @@ -3,7 +3,7 @@ (public_name opam-core) (synopsis "OCaml Package Manager core internal stdlib") ; TODO: Remove (re_export ...) when CI uses the OCaml version that includes https://github.com/ocaml/ocaml/pull/11989 - (libraries re (re_export ocamlgraph) unix sha jsonm swhid_core uutf) + (libraries re (re_export ocamlgraph) unix sha jsonm swhid_core uutf patch) (flags (:standard (:include ../ocaml-flags-standard.sexp) (:include ../ocaml-flags-configure.sexp) diff --git a/src/core/opamSystem.ml b/src/core/opamSystem.ml index 74a46471512..7c995bccb66 100644 --- a/src/core/opamSystem.ml +++ b/src/core/opamSystem.ml @@ -1547,39 +1547,59 @@ let translate_patch ~dir orig corrected = end; close_in ch -let gpatch = lazy begin - let rec search_gpatch = function - | [] -> None - | patch_cmd::patch_cmds -> - match OpamProcess.run (make_command ~name:"patch" patch_cmd ["--version"]) with - | r -> - (match OpamProcess.is_success r, r.OpamProcess.r_stdout with - | true, full::_ when - OpamStd.String.is_prefix_of ~from:0 ~full "GNU patch " -> - Some patch_cmd - | _ -> - search_gpatch patch_cmds) - | exception _ -> search_gpatch patch_cmds +exception Internal_patch_error of string + +let internal_patch ~patch_filename ~dir diffs = + let fmt = Printf.sprintf in + let get_path file = + let dir = real_path dir in + let file = real_path (Filename.concat dir file) in + if not (OpamStd.String.is_prefix_of ~from:0 ~full:file dir) then + raise (Internal_patch_error (fmt "Patch %S tried to escape its scope." patch_filename)); + file in - let default_cmd, other_cmds = - match OpamStd.Sys.os () with - | DragonFly - | FreeBSD - | NetBSD - | OpenBSD -> ("gpatch", ["patch"]) - | Cygwin - | Darwin - | Linux - | Unix - | Win32 - | Other _ -> ("patch", ["gpatch"]) + let patch ~file content diff = + match Patch.patch ~cleanly:true content diff with + | Some x -> x + | None -> assert false + | exception _ -> + match Patch.patch ~cleanly:false content diff with + | Some x -> + OpamStd.Option.iter (write (file^".orig")) content; + x + | None -> assert false + | exception _ -> + raise (Internal_patch_error (fmt "Patch %S does not apply cleanly." patch_filename)) in - match search_gpatch (default_cmd :: other_cmds) with - | Some gpatch -> gpatch - | None -> - OpamConsole.warning "Invalid patch utility. Please install GNU patch"; - default_cmd -end + let apply diff = match diff.Patch.operation with + | Patch.Edit (src, dst) -> + let src = get_path src in + let dst = get_path dst in + if Sys.file_exists src then + let content = read src in + let content = patch ~file:src (Some content) diff in + write dst content; + if not (String.equal src dst) then + Unix.unlink src; + else + (* NOTE: GNU patch ignores when a file doesn't exist *) + let content = read dst in + let content = patch ~file:dst (Some content) diff in + write dst content + | Patch.Delete file -> + let file = get_path file in + (* TODO: apply the patch and check the file is empty *) + Unix.unlink file + | Patch.Create file -> + let file = get_path file in + let content = patch ~file None diff in + write file content + | Patch.Rename_only (src, dst) -> + let src = get_path src in + let dst = get_path dst in + Unix.rename src dst + in + List.iter apply diffs let patch ?(preprocess=true) ~dir p = if not (Sys.file_exists p) then @@ -1593,11 +1613,12 @@ let patch ?(preprocess=true) ~dir p = else p in - let patch_cmd = Lazy.force gpatch in - make_command ~name:"patch" ~dir patch_cmd ["-p1"; "-i"; p'] @@> fun r -> - if not (OpamConsole.debug ()) then Sys.remove p'; - if OpamProcess.is_success r then Done None - else Done (Some (Process_error r)) + let content = read p' in + try + let diffs = Patch.parse ~p:1 content in + internal_patch ~patch_filename:p ~dir diffs; + Done None + with exn -> Done (Some exn) let register_printer () = Printexc.register_printer (function diff --git a/src/core/opamSystem.mli b/src/core/opamSystem.mli index f736089dff8..acb915ce5ee 100644 --- a/src/core/opamSystem.mli +++ b/src/core/opamSystem.mli @@ -116,6 +116,9 @@ val read: string -> string advisory write lock to prevent concurrent reads or writes) *) val write: string -> string -> unit +(** [get_files dir] returns the list of files inside the directory [dir]. *) +val get_files : string -> string list + (** [remove filename] removes [filename]. Works whether [filename] is a file or a directory *) val remove: string -> unit diff --git a/src/repository/opamRepositoryBackend.ml b/src/repository/opamRepositoryBackend.ml index 202c702c083..5833e147ebc 100644 --- a/src/repository/opamRepositoryBackend.ml +++ b/src/repository/opamRepositoryBackend.ml @@ -10,7 +10,7 @@ open OpamTypes -let log = OpamConsole.log "REPO_BACKEND" +let log ?level fmt = OpamConsole.log "REPO_BACKEND" ?level fmt let slog = OpamConsole.slog type update = @@ -73,25 +73,117 @@ let job_text name label = (OpamConsole.colorise `green (OpamRepositoryName.to_string name)) label) +let getfiles parent_dir dir = + let dir = Filename.concat (OpamFilename.Dir.to_string parent_dir) dir in + OpamSystem.get_files dir + +let get_files_for_diff parent_dir dir1 dir2 = match dir1, dir2 with + | None, None -> assert false + | Some dir, None -> + List.map (fun file -> Patch.Delete (Filename.concat dir file)) (getfiles parent_dir dir) + | None, Some dir -> + List.map (fun file -> Patch.Create (Filename.concat 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 (Patch.Edit (Filename.concat dir1 file1, Filename.concat dir2 file2) :: acc) files1 files2 + else if cmp < 0 then + aux (Patch.Delete (Filename.concat dir1 file1) :: acc) files1 orig2 + else + aux (Patch.Create (Filename.concat dir2 file2) :: acc) orig1 files2 + | file1::files1, [] -> + aux (Patch.Delete (Filename.concat dir1 file1) :: acc) files1 [] + | [], file2::files2 -> + aux (Patch.Create (Filename.concat dir2 file2) :: acc) [] files2 + | [], [] -> + acc + in + aux [] files1 files2 + +let readfile parent_dir file = + let file = Filename.concat (OpamFilename.Dir.to_string parent_dir) file in + OpamSystem.read file + +let lstat parent_dir file = + let file = Filename.concat (OpamFilename.Dir.to_string parent_dir) file in + Unix.lstat file + let get_diff parent_dir dir1 dir2 = + 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 patch = OpamSystem.temp_file ~auto_clean: false "patch" in - let patch_file = OpamFilename.of_string patch in - let finalise () = OpamFilename.remove patch_file in - OpamProcess.Job.catch (fun e -> finalise (); raise e) @@ fun () -> - OpamSystem.make_command - ~verbose:OpamCoreConfig.(!r.verbose_level >= 2) - ~dir:(OpamFilename.Dir.to_string parent_dir) ~stdout:patch - "diff" - [ "-ruaN"; - OpamFilename.Base.to_string dir1; - OpamFilename.Base.to_string dir2; ] - @@> function - | { OpamProcess.r_code = 0; _ } -> finalise(); Done None - | { OpamProcess.r_code = 1; _ } as r -> - OpamProcess.cleanup ~force:true r; + let rec aux diffs dir1 dir2 = + let files = get_files_for_diff parent_dir dir1 dir2 in + let diffs = + List.fold_left (fun diffs operation -> + let file1, file2 = match operation with + | Patch.Delete filename -> (Some filename, None) + | Patch.Create filename -> (None, Some filename) + | Patch.Edit (file1, file2) + | Patch.Rename_only (file1, file2) -> (Some file1, Some file2) + in + let add_to_diffs content1 content2 diffs = + match Patch.diff operation content1 content2 with + | None -> diffs + | Some diff -> diff :: diffs + in + match OpamStd.Option.map (lstat parent_dir) file1, OpamStd.Option.map (lstat parent_dir) file2 with + | Some {Unix.st_kind = Unix.S_REG; _}, None + | None, Some {Unix.st_kind = Unix.S_REG; _} + | Some {Unix.st_kind = Unix.S_REG; _}, Some {Unix.st_kind = Unix.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 {Unix.st_kind = Unix.S_DIR; _}, None + | None, Some {Unix.st_kind = Unix.S_DIR; _} + | Some {Unix.st_kind = Unix.S_DIR; _}, Some {Unix.st_kind = Unix.S_DIR; _} -> + aux diffs file1 file2 + | Some {Unix.st_kind = Unix.S_LNK; _}, None + | None, Some {Unix.st_kind = Unix.S_LNK; _} + | Some {Unix.st_kind = Unix.S_LNK; _}, Some {Unix.st_kind = Unix.S_LNK; _} -> + assert false (* TODO *) + | Some {Unix.st_kind = Unix.S_REG; _}, Some {Unix.st_kind = Unix.S_DIR; _} -> + assert false (* TODO *) + | Some {Unix.st_kind = Unix.S_DIR; _}, Some {Unix.st_kind = Unix.S_REG; _} -> + assert false (* TODO *) + | Some {Unix.st_kind = Unix.S_REG; _}, Some {Unix.st_kind = Unix.S_LNK; _} -> + assert false (* TODO *) + | Some {Unix.st_kind = Unix.S_LNK; _}, Some {Unix.st_kind = Unix.S_REG; _} -> + assert false (* TODO *) + | Some {Unix.st_kind = Unix.S_LNK; _}, Some {Unix.st_kind = Unix.S_DIR; _} -> + assert false (* TODO *) + | Some {Unix.st_kind = Unix.S_DIR; _}, Some {Unix.st_kind = Unix.S_LNK; _} -> + assert false (* TODO *) + | Some {Unix.st_kind = Unix.S_CHR; _}, _ | _, Some {Unix.st_kind = Unix.S_CHR; _} -> + failwith "Character devices are unsupported" + | Some {Unix.st_kind = Unix.S_BLK; _}, _ | _, Some {Unix.st_kind = Unix.S_BLK; _} -> + failwith "Block devices are unsupported" + | Some {Unix.st_kind = Unix.S_FIFO; _}, _ | _, Some {Unix.st_kind = Unix.S_FIFO; _} -> + failwith "Named pipes are unsupported" + | Some {Unix.st_kind = Unix.S_SOCK; _}, _ | _, Some {Unix.st_kind = Unix.S_SOCK; _} -> + failwith "Sockets are unsupported" + | None, None -> assert false) + diffs files + in + diffs + in + match + aux [] + (Some (OpamFilename.Base.to_string dir1)) + (Some (OpamFilename.Base.to_string dir2)) + with + | [] -> + log "Internal diff (empty) done in %.2fs." (chrono ()); + Done None + | diffs -> + log "Internal diff (non-empty) done in %.2fs." (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); Done (Some patch_file) - | r -> OpamSystem.process_error r diff --git a/src_ext/Makefile b/src_ext/Makefile index 0238d81e416..769f4157a58 100644 --- a/src_ext/Makefile +++ b/src_ext/Makefile @@ -22,7 +22,7 @@ ifndef FETCH endif endif -SRC_EXTS = cppo base64 extlib re cmdliner ocamlgraph cudf dose3 opam-file-format seq stdlib-shims spdx_licenses opam-0install-cudf 0install-solver uutf jsonm sha swhid_core +SRC_EXTS = cppo base64 extlib re cmdliner ocamlgraph cudf dose3 opam-file-format seq stdlib-shims spdx_licenses opam-0install-cudf 0install-solver uutf jsonm sha swhid_core patch ifeq ($(MCCS_ENABLED),true) SRC_EXTS := $(SRC_EXTS) mccs diff --git a/src_ext/Makefile.sources b/src_ext/Makefile.sources index 3ed5cae4811..fe6a8c03ce8 100644 --- a/src_ext/Makefile.sources +++ b/src_ext/Makefile.sources @@ -56,3 +56,6 @@ MD5_sha = 08bc953d9a26380bc220b05d680791fb URL_swhid_core = https://github.com/OCamlPro/swhid_core/archive/refs/tags/0.1.tar.gz MD5_swhid_core = 77d88d4b1d96261c866f140c64d89af8 + +URL_patch = https://github.com/hannesm/patch/releases/download/v1.0.1/patch-1.0.1.tbz +MD5_patch = 95fa7e25ae8de6a58b223efee2a769d0 diff --git a/tests/reftests/repository.test b/tests/reftests/repository.test index b69a44b676b..b3f374afcf7 100644 --- a/tests/reftests/repository.test +++ b/tests/reftests/repository.test @@ -19,9 +19,6 @@ some content ### : Internal repository storage as archive or plain directory : ### opam switch create tarring --empty ### opam update -vv | grep '^\+' | sed-cmd diff | sed-cmd patch | 'patch-[^"]+' -> 'patch' -+ diff "-ruaN" "default" "default.new" (CWD=${BASEDIR}/OPAM/repo) -+ patch "--version" -+ patch "-p1" "-i" "${BASEDIR}/OPAM/log/patch" (CWD=${BASEDIR}/OPAM/repo/default) ### ls $OPAMROOT/repo | grep -v "cache" default lock @@ -39,9 +36,6 @@ build: ["test" "-f" "baz"] some content ### sh hash.sh REPO foo.2 ### opam update default -vv | grep '^\+' | sed-cmd tar | sed-cmd diff | sed-cmd patch | 'patch-[^"]+' -> 'patch' -+ diff "-ruaN" "default" "default.new" (CWD=${BASEDIR}/OPAM/repo) -+ patch "--version" -+ patch "-p1" "-i" "${BASEDIR}/OPAM/log/patch" (CWD=${BASEDIR}/OPAM/repo/default) + tar "cfz" "${BASEDIR}/OPAM/repo/default.tar.gz.tmp" "-C" "${BASEDIR}/OPAM/repo" "default" ### ls $OPAMROOT/repo | grep -v "cache" default.tar.gz @@ -80,9 +74,6 @@ some content ### sh hash.sh REPO foo.4 ### opam update -vv | grep '^\+' | sed-cmd tar | sed-cmd diff | sed-cmd patch | 'patch-[^"]+' -> 'patch' + tar "xfz" "${BASEDIR}/OPAM/repo/tarred.tar.gz" "-C" "${OPAMTMP}" -+ diff "-ruaN" "tarred" "tarred.new" (CWD=${OPAMTMP}) -+ patch "--version" -+ patch "-p1" "-i" "${BASEDIR}/OPAM/log/patch" (CWD=${OPAMTMP}/tarred) + tar "cfz" "${BASEDIR}/OPAM/repo/tarred.tar.gz.tmp" "-C" "${OPAMTMP}" "tarred" ### opam install foo.4 -vv | grep '^\+' | sed-cmd test | sed-cmd tar + tar "xfz" "${BASEDIR}/OPAM/repo/tarred.tar.gz" "-C" "${OPAMTMP}" @@ -104,9 +95,6 @@ some content ### sh hash.sh REPO foo.5 ### opam update -vv | grep '^\+' | sed-cmd tar | sed-cmd diff | sed-cmd patch | 'patch-[^"]+' -> 'patch' + tar "xfz" "${BASEDIR}/OPAM/repo/tarred.tar.gz" "-C" "${OPAMTMP}" -+ diff "-ruaN" "tarred" "tarred.new" (CWD=${OPAMTMP}) -+ patch "--version" -+ patch "-p1" "-i" "${BASEDIR}/OPAM/log/patch" (CWD=${OPAMTMP}/tarred) ### opam install foo.5 -vv | grep '^\+' | sed-cmd test + test "-f" "quux" (CWD=${BASEDIR}/OPAM/tarring/.opam-switch/build/foo.5) ### ls $OPAMROOT/repo | grep -v "cache" From 6a05509c485c254cb85549325c801a0631e19008 Mon Sep 17 00:00:00 2001 From: Kate Date: Fri, 11 Oct 2024 12:55:42 +0100 Subject: [PATCH 2/3] fix edition behaviour (fixup frama-c.9.1) --- src/core/opamSystem.ml | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/src/core/opamSystem.ml b/src/core/opamSystem.ml index 7c995bccb66..774c8742a5e 100644 --- a/src/core/opamSystem.ml +++ b/src/core/opamSystem.ml @@ -1572,20 +1572,18 @@ let internal_patch ~patch_filename ~dir diffs = raise (Internal_patch_error (fmt "Patch %S does not apply cleanly." patch_filename)) in let apply diff = match diff.Patch.operation with - | Patch.Edit (src, dst) -> - let src = get_path src in - let dst = get_path dst in - if Sys.file_exists src then - let content = read src in - let content = patch ~file:src (Some content) diff in - write dst content; - if not (String.equal src dst) then - Unix.unlink src; - else - (* NOTE: GNU patch ignores when a file doesn't exist *) - let content = read dst in - let content = patch ~file:dst (Some content) diff in - write dst content + | Patch.Edit (file1, file2) -> + (* That seems to be the GNU patch behaviour *) + let file = + let file1 = get_path file1 in + if Sys.file_exists file1 then + file1 + else + get_path file2 + in + let content = read file in + let content = patch ~file:file (Some content) diff in + write file content; | Patch.Delete file -> let file = get_path file in (* TODO: apply the patch and check the file is empty *) From 10a485ee8566ba7e4536f17e619ed2388a0c8dab Mon Sep 17 00:00:00 2001 From: Kate Date: Sun, 19 Jan 2025 17:09:40 +0000 Subject: [PATCH 3/3] Write .orig and .rej files upon failure to patch file --- src/core/opamSystem.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/core/opamSystem.ml b/src/core/opamSystem.ml index 774c8742a5e..2194d590b2a 100644 --- a/src/core/opamSystem.ml +++ b/src/core/opamSystem.ml @@ -1569,6 +1569,8 @@ let internal_patch ~patch_filename ~dir diffs = x | None -> assert false | exception _ -> + OpamStd.Option.iter (write (file^".orig")) content; + write (file^".rej") (Format.asprintf "%a" Patch.pp diff); raise (Internal_patch_error (fmt "Patch %S does not apply cleanly." patch_filename)) in let apply diff = match diff.Patch.operation with