Merge pull request #4879 from rjbou/fx

Fix working dir checkout

CHANGES

@@ -29,6 +29,9 @@ are not marked). Those prefixed with "(+)" are new command/option (since
 * [BUG] Handle external dependencies when updating switch state pin status (all
   pins), instead as a post pin action (only when called with `opam pin`
   [#5047 @rjbou - fix #5046]
+* [BUG] When reinstalling a package that has a dirty source, if uncommitted
+  changes are the same than the ones stored in opam's cache, opam consider that
+  it is up to date and nothing is updated [4879 @rjbou]
 * Stop Zypper from upgrading packages on updates on OpenSUSE
   [#4978 @kit-ty-kate]
 * Clearer error message if a command doesn't exist

src/repository/opamDarcs.ml

@@ -81,10 +81,14 @@ module VCS = struct
     OpamSystem.raise_on_process_error r;
     Done ()
 
-  let reset_tree repo_root _repo_url =
+  let clean repo_root =
     darcs repo_root [ "obliterate"; "--all"; "-t"; opam_local_tag ]
     @@> fun r ->
     OpamSystem.raise_on_process_error r;
+    Done ()
+
+  let reset_tree repo_root _repo_url =
+    clean repo_root @@+ fun () ->
     darcs repo_root [ "obliterate"; "--all"; "-p"; opam_reverse_commit ]
     @@> fun r ->
     (* returns 0 even if patch doesn't exist *)

src/repository/opamGit.ml

@@ -162,18 +162,20 @@ module VCS : OpamVCS.VCS = struct
          else
            Done (Some full))
 
+  let clean repo_root =
+    git repo_root [ "clean"; "-fdx" ]
+    @@> fun r ->
+    OpamSystem.raise_on_process_error r;
+    Done ()
+
   let reset_tree repo_root repo_url =
     let rref = remote_ref repo_url in
     git repo_root [ "reset" ; "--hard"; rref; "--" ]
     @@> fun r ->
     if OpamProcess.is_failure r then
       OpamSystem.internal_error "Git error: %s not found." rref
     else
-      git repo_root [ "clean"; "-fdx" ]
-      @@> fun r ->
-      if OpamProcess.is_failure r then
-        OpamSystem.internal_error "Git error: %s not found." rref
-      else
+      clean repo_root @@+ fun () ->
       if OpamFilename.exists (repo_root // ".gitmodules") then
         git repo_root [ "submodule"; "update"; "--init"; "--recursive" ]
         @@> fun r ->

src/repository/opamHg.ml

@@ -56,6 +56,12 @@ module VCS = struct
       if String.length full > 8 then Done (Some (String.sub full 0 8))
       else Done (Some full)
 
+  let clean repo_root =
+    hg repo_root ["revert"; "--all"; "--no-backup"]
+    @@> fun r ->
+    OpamSystem.raise_on_process_error r;
+    Done ()
+
   let reset_tree repo_root repo_url =
     let mark = mark_from_url repo_url in
     hg repo_root [ "update"; "--clean"; "--rev"; mark ] @@> fun r ->

src/repository/opamVCS.ml

@@ -29,6 +29,7 @@ module type VCS = sig
   val is_dirty: ?subpath:string -> dirname -> bool OpamProcess.job
   val modified_files: dirname -> string list OpamProcess.job
   val get_remote_url: ?hash:string -> dirname -> url option OpamProcess.job
+  val clean: dirname -> unit OpamProcess.job
 end
 
 let convert_path =
@@ -83,6 +84,7 @@ module Make (VCS: VCS) = struct
          Done (Not_available (None, OpamUrl.to_string url)))
     @@ fun () ->
     if VCS.exists dirname then
+      VCS.clean dirname @@+ fun () ->
       VCS.fetch ?cache_dir ?subpath dirname url @@+ fun () ->
       VCS.is_up_to_date dirname url @@+ function
       | true -> Done (Up_to_date None)

src/repository/opamVCS.mli

@@ -68,10 +68,14 @@ module type VCS = sig
   val is_dirty: ?subpath:string -> dirname -> bool OpamProcess.job
 
   (** Returns the list of files under version control, modified in the working
-      tree but not comitted *)
+      tree but not committed *)
   val modified_files: dirname -> string list OpamProcess.job
 
+  (* Returns associated remote url, if found *)
   val get_remote_url: ?hash:string -> dirname -> url option OpamProcess.job
+
+  (* Remove uncommitted changes *)
+  val clean: dirname -> unit OpamProcess.job
 end
 
 (** Create a backend from a [VCS] implementation. *)

tests/reftests/dune.inc

@@ -532,6 +532,23 @@
    %{targets}
    (run ./run.exe %{bin:opam} %{dep:var-option.test} %{read-lines:testing-env}))))
 
+(alias
+ (name reftest-working-dir)
+ (action
+  (diff working-dir.test working-dir.out)))
+
+(alias
+ (name reftest)
+ (deps (alias reftest-working-dir)))
+
+(rule
+ (targets working-dir.out)
+ (deps root-N0REP0)
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./run.exe %{bin:opam} %{dep:working-dir.test} %{read-lines:testing-env}))))
+
 (rule
  (targets opam-repo-N0REP0)
  (action