Patch rewrite tests

.gitattributes

@@ -10,6 +10,9 @@ msvs-detect text eol=lf
 check_linker text eol=lf
 *.m4 text eol=lf
 
+# For diffing simplicity, the patch re-write test uses LF endings on Windows
+tests/patcher-test.reference text eol=lf
+
 # Treat patches as binary for safety
 *.patch binary
 

Makefile

@@ -155,7 +155,7 @@ checker:
 
 .PHONY: tests tests-local tests-git
 tests: $(DUNE_DEP)
-	$(DUNE) build --profile=$(DUNE_PROFILE) $(DUNE_ARGS) opam.install src/tools/opam_check.exe
+	$(DUNE) build --profile=$(DUNE_PROFILE) $(DUNE_ARGS) opam.install src/tools/opam_check.exe tests/patcher.exe
 	$(DUNE) runtest --force --no-buffer --profile=$(DUNE_PROFILE) $(DUNE_ARGS) src/ tests/
 
 .PHONY: crowbar

src/client/opamArg.ml

@@ -236,6 +236,9 @@ let help_sections = [
   `P "$(i,OPAMCURL) can be used to select a given 'curl' program. See \
       $(i,OPAMFETCH) for more options.";
   `P "$(i,OPAMDEBUG) see options `--debug' and `--debug-level'.";
+  `P "$(i,OPAMDEBUGSECTIONS) if set, limits debug messages to the space-separated \
+      list of sections. Sections can optionally have a specific debug level \
+      (for example, $(b,CLIENT:2) or $(b,CLIENT CUDF:2), but otherwise use `--debug-level'.";
   `P "$(i,OPAMDOWNLOADJOBS) sets the maximum number of simultaneous downloads.";
   `P "$(i,OPAMDRYRUN) see option `--dry-run`";
   `P "$(i,OPAMEDITOR) sets the editor to use for opam file editing, overrides \

src/client/opamClientConfig.mli

@@ -107,6 +107,7 @@ val opam_init:
   ?retries:int ->
   ?force_checksums:bool option ->
   ?debug_level:int ->
+  ?debug_sections:int option OpamCoreConfig.StringMap.t ->
   ?verbose_level:int ->
   ?color:[ `Always | `Auto | `Never ] ->
   ?utf8:[ `Always | `Auto | `Extended | `Never ] ->

src/client/opamCommands.ml

@@ -89,7 +89,7 @@ let global_options =
     if self_upgrade_status = `None then
       switch_to_updated_self
         OpamStd.Option.Op.(options.debug_level ++
-                           OpamStd.Config.env_level "DEBUG" +! 0 > 0)
+                           OpamStd.Config.env_level "DEBUG" +! 0 |> abs > 0)
         (OpamStateConfig.opamroot ?root_dir:options.opt_root ());
     let root_is_ok =
       OpamStd.Option.default false (OpamStd.Config.env_bool "ROOTISOK")

src/core/opamConsole.ml

@@ -13,7 +13,7 @@ open OpamCompat
 
 (* Global configuration *)
 
-let debug () = OpamCoreConfig.(!r.debug_level) > 0
+let debug () = abs OpamCoreConfig.(!r.debug_level) > 0
 
 let verbose () = OpamCoreConfig.(!r.verbose_level) > 0
 
@@ -496,19 +496,31 @@ let timestamp () =
     (int_of_float (1000.0 *. msec))
 
 let log section ?(level=1) fmt =
-  if level <= OpamCoreConfig.(!r.debug_level) then
+  let debug_level =
+    let debug_level = OpamCoreConfig.(!r.debug_level) in
+    let sections = OpamCoreConfig.(!r.debug_sections) in
+    if OpamCoreConfig.StringMap.is_empty sections then
+      debug_level
+    else
+      match OpamCoreConfig.StringMap.find section sections with
+      | Some level -> level
+      | None -> debug_level
+      | exception Not_found -> 0
+  in
+  if level <= abs debug_level then
     let () = clear_status () in
+    let timestamp = if debug_level < 0 then "" else timestamp () ^ "  " in
     if Sys.win32 then begin
       (*
        * In order not to break [slog], split the output into two. A side-effect
        * of this is that logging lines may not use colour.
        *)
-      win32_print_message `stderr (Printf.sprintf "%s  %a  "
-        (timestamp ()) (acolor_with_width (Some 30) `yellow) section);
+      win32_print_message `stderr (Printf.sprintf "%s%a  "
+        timestamp (acolor_with_width (Some 30) `yellow) section);
       Printf.fprintf stderr (fmt ^^ "\n%!") end
     else
-      Printf.fprintf stderr ("%s  %a  " ^^ fmt ^^ "\n%!")
-        (timestamp ()) (acolor_w 30 `yellow) section
+      Printf.fprintf stderr ("%s%a  " ^^ fmt ^^ "\n%!")
+        timestamp (acolor_w 30 `yellow) section
   else
     Printf.ifprintf stderr fmt
 

src/core/opamCoreConfig.ml

@@ -10,8 +10,11 @@
 
 open OpamCompat
 
+module StringMap = Map.Make(String)
+
 type t = {
   debug_level: int;
+  debug_sections: int option StringMap.t;
   verbose_level: int;
   color: [ `Always | `Never | `Auto ];
   utf8: [ `Extended | `Always | `Never | `Auto ];
@@ -28,6 +31,7 @@ type t = {
 
 type 'a options_fun =
   ?debug_level:int ->
+  ?debug_sections:int option StringMap.t ->
   ?verbose_level:int ->
   ?color:[ `Always | `Never | `Auto ] ->
   ?utf8:[ `Extended | `Always | `Never | `Auto ] ->
@@ -44,6 +48,7 @@ type 'a options_fun =
 
 let default = {
   debug_level = 0;
+  debug_sections = StringMap.empty;
   verbose_level = 0;
   color = `Auto;
   utf8 = `Auto;
@@ -63,6 +68,7 @@ let default = {
 
 let setk k t
     ?debug_level
+    ?debug_sections
     ?verbose_level
     ?color
     ?utf8
@@ -79,6 +85,7 @@ let setk k t
   let (+) x opt = match opt with Some x -> x | None -> x in
   k {
     debug_level = t.debug_level + debug_level;
+    debug_sections = t.debug_sections + debug_sections;
     verbose_level = t.verbose_level + verbose_level;
     color = t.color + color;
     utf8 = t.utf8 + utf8;

src/core/opamCoreConfig.mli

@@ -11,9 +11,14 @@
 (** Configuration options for the core lib (record, global reference and
     setter) *)
 
+module StringMap : Map.S with type key = string
+
 type t = private {
   debug_level : int;
   (** Controls debug messages, 0 to disable *)
+  debug_sections : int option StringMap.t;
+  (** Controls which sections display debugging messages. If empty, all messages
+      are displayed. *)
   verbose_level : int;
   (** Controls printing of external commands and output, 0 to disable, more
       means print more low-level commands *)
@@ -49,6 +54,7 @@ type t = private {
 
 type 'a options_fun =
   ?debug_level:int ->
+  ?debug_sections:int option StringMap.t ->
   ?verbose_level:int ->
   ?color:[ `Always | `Never | `Auto ] ->
   ?utf8:[ `Extended | `Always | `Never | `Auto ] ->

src/core/opamStd.ml

@@ -1328,6 +1328,22 @@ module Config = struct
         | s -> int_of_string s)
       var
 
+  let env_sections var =
+    env (fun s ->
+      let f map elt =
+        let parse_value (section, value) =
+          try
+            (section, Some (int_of_string value))
+          with Failure _ ->
+            (section, None)
+        in
+        let (section, level) =
+          Option.map_default parse_value (elt, None) (OpamString.cut_at elt ':')
+        in
+        OpamCoreConfig.StringMap.add section level map
+      in
+      List.fold_left f OpamCoreConfig.StringMap.empty (OpamString.split s ' ')) var
+
   let env_string var =
     env (fun s -> s) var
 
@@ -1370,6 +1386,7 @@ module Config = struct
     in
     OpamCoreConfig.(setk (setk (fun c -> r := c; k)) !r)
       ?debug_level:(env_level "DEBUG")
+      ?debug_sections:(env_sections "DEBUGSECTIONS")
       ?verbose_level:(env_level "VERBOSE")
       ?color:(env_when "COLOR")
       ?utf8

src/core/opamSystem.mli

@@ -264,6 +264,21 @@ val get_lock_fd: lock -> Unix.file_descr
     apply. *)
 val patch: ?preprocess:bool -> dir:string -> string -> exn option OpamProcess.job
 
+(** 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
+
 (** Create a temporary file in {i ~/.opam/logs/<name>XXX}, if [dir] is not set.
     ?auto_clean controls whether the file is automatically deleted when opam
     terminates (default: [true]). *)

src/solver/opamBuiltinMccs.ml.real

@@ -32,7 +32,7 @@ let call solver_backend ext ~criteria ?timeout cudf =
   match
     Mccs.resolve_cudf
       ~solver
-      ~verbose:OpamCoreConfig.(!r.debug_level >= 2)
+      ~verbose:OpamCoreConfig.(abs !r.debug_level >= 2)
       ?timeout criteria cudf
   with
   | None -> raise Common.CudfSolver.Unsat

src/solver/opamCudfSolver.ml

@@ -52,7 +52,7 @@ let call_external_solver command ~criteria ?timeout (_, universe,_ as cudf) =
           command
       in
       OpamSystem.command
-        ~verbose:(OpamCoreConfig.(!r.debug_level >= 2))
+        ~verbose:(OpamCoreConfig.(abs !r.debug_level >= 2))
         cmd
     in
     OpamFilename.remove solver_in;

tests/dune

@@ -4,3 +4,15 @@
   (action (run make all)))
 
 (ignored_subdirs (packages))
+
+(executable
+  (name      patcher)
+  (modules   patcher)
+  (libraries opam-core))
+
+(rule
+  (with-stdout-to patcher-test.result (run %{exe:patcher.exe})))
+
+(alias
+  (name runtest)
+  (action (system "diff %{dep:patcher-test.result} %{dep:patcher-test.reference}")))

tests/patcher-test.reference

@@ -0,0 +1,77 @@
+PATCH                           No CRLF adaptation necessary for b/always-crlf
+PATCH                           No CRLF adaptation necessary for b/always-lf
+PATCH                           CRLF adaptation skipped for b/no-eol-at-all
+PATCH                           No CRLF adaptation necessary for b/no-eol-at-eof
+PATCH                           CRLF adaptation skipped for b/null-file
+PATCH                           No CRLF adaptation necessary for b/test1
+PATCH                           No CRLF adaptation necessary for b/test2
+PATCH                           No CRLF adaptation necessary for b/test3
+PATCH                           No CRLF adaptation necessary for b/will-null-file
+Before patch state of c:
+  ./always-crlf: CRLF
+  ./always-lf: LF
+  ./no-eol-at-all: mixed (no eol-at-eof)
+  ./no-eol-at-eof: LF (no eol-at-eof)
+  ./null-file: mixed (no eol-at-eof)
+  ./test1: LF
+  ./test2: LF
+  ./test3: LF
+  ./will-null-file: LF
+patching file always-crlf
+patching file always-lf
+patching file no-eol-at-all
+patching file no-eol-at-eof
+patching file null-file
+patching file test1
+patching file test2
+patching file test3
+patching file will-null-file
+After patch state of c:
+  ./always-crlf: CRLF
+  ./always-lf: LF
+  ./no-eol-at-all: mixed (no eol-at-eof)
+  ./no-eol-at-eof: LF (no eol-at-eof)
+  ./null-file: LF
+  ./test1: LF
+  ./test2: LF
+  ./will-null-file: mixed (no eol-at-eof)
+PATCH                           No CRLF adaptation necessary for b/always-crlf
+PATCH                           No CRLF adaptation necessary for b/always-lf
+PATCH                           CRLF adaptation skipped for b/no-eol-at-all
+PATCH                           Adding \r to patch chunks for b/no-eol-at-eof
+PATCH                           CRLF adaptation skipped for b/null-file
+PATCH                           No CRLF adaptation necessary for b/test1
+PATCH                           Adding \r to patch chunks for b/test2
+PATCH                           No CRLF adaptation necessary for b/test3
+PATCH                           Adding \r to patch chunks for b/will-null-file
+PATCH                           Transform 32-36 +\r
+PATCH                           Transform 62-67 +\r
+PATCH                           Transform 82-87 +\r
+Before patch state of c:
+  ./always-crlf: CRLF
+  ./always-lf: LF
+  ./no-eol-at-all: mixed (no eol-at-eof)
+  ./no-eol-at-eof: CRLF (no eol-at-eof)
+  ./null-file: mixed (no eol-at-eof)
+  ./test1: LF
+  ./test2: CRLF
+  ./test3: LF
+  ./will-null-file: CRLF
+patching file always-crlf
+patching file always-lf
+patching file no-eol-at-all
+patching file no-eol-at-eof
+patching file null-file
+patching file test1
+patching file test2
+patching file test3
+patching file will-null-file
+After patch state of c:
+  ./always-crlf: CRLF
+  ./always-lf: LF
+  ./no-eol-at-all: mixed (no eol-at-eof)
+  ./no-eol-at-eof: CRLF (no eol-at-eof)
+  ./null-file: LF
+  ./test1: LF
+  ./test2: CRLF
+  ./will-null-file: mixed (no eol-at-eof)