[Unison-hackers] [unison-svn] r426 - trunk/src

[vouillon@seas.upenn.edu]

Author: vouillon
Date: 2010-03-29 18:03:43 -0400 (Mon, 29 Mar 2010)
New Revision: 426

Modified:
   trunk/src/RECENTNEWS
   trunk/src/mkProjectInfo.ml
   trunk/src/update.ml
Log:
* Fix Not_found error when no archives are found (recently introduced bug).


Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS	2010-03-26 14:49:42 UTC (rev 425)
+++ trunk/src/RECENTNEWS	2010-03-29 22:03:43 UTC (rev 426)
@@ -1,5 +1,10 @@
 CHANGES FROM VERSION 2.40.16
 
+* Fix Not_found error when no archives are found (recently introduced bug).
+
+-------------------------------
+CHANGES FROM VERSION 2.40.16
+
 * Fix Windows compilation bug introduced in previous commit
 
 -------------------------------

Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml	2010-03-26 14:49:42 UTC (rev 425)
+++ trunk/src/mkProjectInfo.ml	2010-03-29 22:03:43 UTC (rev 426)
@@ -105,3 +105,4 @@
 
 
 
+

Modified: trunk/src/update.ml
===================================================================
--- trunk/src/update.ml	2010-03-26 14:49:42 UTC (rev 425)
+++ trunk/src/update.ml	2010-03-29 22:03:43 UTC (rev 426)
@@ -748,7 +748,7 @@
      ^ "after loading it.")
 
 (* For all roots (local or remote), load the archive and cache *)
-let loadArchives (optimistic: bool) : bool Lwt.t =
+let loadArchives (optimistic: bool) =
   Globals.allRootsMap (fun r -> loadArchiveOnRoot r optimistic)
      >>= (fun checksums ->
   let identicals = archivesIdentical checksums in
@@ -770,11 +770,7 @@
       ^ "       arXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n"
       ^ "     where the X's are a hexidecimal number .\n"
       ^ "  c) Run unison again to synchronize from scratch.\n"));
-  checkArchiveCaseSensitivity checksums >>= fun () ->
-  if Prefs.read dumpArchives then
-    Globals.allRootsMap (fun r -> dumpArchiveOnRoot r ())
-     >>= (fun _ -> Lwt.return identicals)
-  else Lwt.return identicals)
+  Lwt.return (identicals, checksums))
 
 
 (*****************************************************************************)
@@ -1814,17 +1810,24 @@
 
 let findUpdatesOnPaths pathList =
   Lwt_unix.run
-    (loadArchives true >>= (fun ok ->
-     begin if ok then Lwt.return () else begin
+    (loadArchives true >>= (fun (ok, checksums) ->
+     begin if ok then Lwt.return checksums else begin
        lockArchives () >>= (fun () ->
        Remote.Thread.unwindProtect
          (fun () ->
             doArchiveCrashRecovery () >>= (fun () ->
             loadArchives false))
          (fun _ ->
-            unlockArchives ()) >>= (fun _ ->
-       unlockArchives ()))
-     end end >>= (fun () ->
+            unlockArchives ()) >>= (fun (_, checksums) ->
+       unlockArchives () >>= fun () ->
+       Lwt.return checksums))
+     end end >>= (fun checksums ->
+     checkArchiveCaseSensitivity checksums >>= fun () ->
+     begin if Prefs.read dumpArchives then
+       Globals.allRootsIter (fun r -> dumpArchiveOnRoot r ())
+     else
+       Lwt.return ()
+     end >>= fun () ->
      let t = Trace.startTimer "Collecting changes" in
      Globals.allRootsMapWithWaitingAction (fun r ->
        debug (fun() -> Util.msg "findOnRoot %s\n" (root2string r));