* Various small changes

9 files changed, 30 insertions, 16 deletions

diff --git a/src/Makefile.OCaml b/src/Makefile.OCaml
index f9b6012..fb96118 100644
--- a/src/Makefile.OCaml
+++ b/src/Makefile.OCaml
@@ -416,7 +416,9 @@ clean::
 	-$(RM) -r *.o core gmon.out *~ .*~
 	-$(RM) -r *.obj *.lib *.exp
 	-$(RM) -r *.tmp *.bak?.tmp .*.bak?.tmp
-	-$(RM) system/*.cm[iox] system/*.{o,obj}
+	-$(RM) system/*.cm[iox] system/*.{o,obj} system/win/*~
+	-$(RM) system/generic/*.cm[iox] system/generic/*.{o,obj} system/generic/*~
+	-$(RM) system/win/*.cm[iox] system/win/*.{o,obj} system/win/*~
 
 .PHONY: paths
 paths:
diff --git a/src/RECENTNEWS b/src/RECENTNEWS
index 0cb8eff..3988e64 100644
--- a/src/RECENTNEWS
+++ b/src/RECENTNEWS
@@ -1,5 +1,10 @@
 CHANGES FROM VERSION 2.35.-17
 
+* Various small changes
+
+-------------------------------
+CHANGES FROM VERSION 2.35.-17
+
 * Use a better file name for keeping a copy of an incorrectly
   transferred file.  In particular, this is now a temp filename, and
   Unison will not try to propagate it next time it is run.
diff --git a/src/case.ml b/src/case.ml
index d6ed375..12d2a55 100644
--- a/src/case.ml
+++ b/src/case.ml
@@ -133,7 +133,7 @@ Important invariant:
 let sensitiveOps = object
   method mode = Sensitive
   method modeDesc = "case sensitive"
-  method compare s s' = compare s s'
+  method compare s s' = compare (s : string) s'
   method hash s = Hashtbl.hash s
   method normalizePattern s = s
   method caseInsensitiveMatch = false
diff --git a/src/copy.ml b/src/copy.ml
index aecd9ec..d183083 100644
--- a/src/copy.ml
+++ b/src/copy.ml
@@ -88,7 +88,7 @@ let checkContentsChangeLocal
        Transfer aborted."
       (Fspath.toPrintString (Fspath.concat fspathFrom pathFrom))))
 
-let checkContentsChangeOnHost =
+let checkContentsChangeOnRoot =
   Remote.registerRootCmd
     "checkContentsChange"
     (fun (fspathFrom,
@@ -99,7 +99,7 @@ let checkContentsChangeOnHost =
 
 let checkContentsChange
       root pathFrom archDesc archDig archStamp archRess paranoid =
-  checkContentsChangeOnHost
+  checkContentsChangeOnRoot
     root (pathFrom, archDesc, archDig, archStamp, archRess, paranoid)
 
 (****)
@@ -211,11 +211,9 @@ let copyContents fspathFrom pathFrom fspathTo pathTo fileKind fileLength ido =
 
 let localFile
      fspathFrom pathFrom fspathTo pathTo realPathTo update desc ressLength ido =
-(*  let use_id f = match ido with Some id -> f id | None -> () in*)
   Util.convertUnixErrorsToTransient
     "copying locally"
     (fun () ->
-(*      use_id (fun id -> Uutil.showProgress id Uutil.Filesize.zero "l");*)
       debug (fun () ->
         Util.msg "Copy.localFile %s / %s to %s / %s\n"
           (Fspath.toDebugString fspathFrom) (Path.toString pathFrom)
@@ -462,7 +460,6 @@ let transferFileContents
   Lwt.catch
     (fun () ->
        decompressor := Remote.MsgIdMap.add file_id decompr !decompressor;
-       Uutil.showProgress id Uutil.Filesize.zero "f";
        compressRemotely connFrom
          (bi, fspathFrom, pathFrom, fileKind, srcFileSize, id, file_id)
          >>= fun () ->
@@ -720,7 +717,8 @@ let transferFile
            rootFrom pathFrom rootTo fspathTo pathTo realPathTo
            update desc fp ress id useExistingTarget
   in
-  (* When streaming, we only transfer one file at a time *)
+  (* When streaming, we only transfer one file at a time, so we don't
+     need to limit the number of concurrent transfers *)
   if Prefs.read Remote.streamingActivated then
     f ()
   else
diff --git a/src/globals.mli b/src/globals.mli
index 8d9f3ad..51efcb0 100644
--- a/src/globals.mli
+++ b/src/globals.mli
@@ -22,8 +22,8 @@ val roots : unit -> Common.root * Common.root
 (* same thing, as a list                                                     *)
 val rootsList : unit -> Common.root list
 
-(* same thing, but in a standard order and ensuring that the Local root, if  *)
-(* any, comes first                                                          *)
+(* same thing, but in a standard order and ensuring that a Local root        *)
+(* comes first                                                               *)
 val rootsInCanonicalOrder : unit -> Common.root list
 
 (* Run a command on all roots                                                *)
diff --git a/src/mkProjectInfo.ml b/src/mkProjectInfo.ml
index 5af1c3c..b5e45ec 100644
--- a/src/mkProjectInfo.ml
+++ b/src/mkProjectInfo.ml
@@ -164,3 +164,4 @@ Printf.printf "NAME=%s\n" projectName;;
 
 
 
+
diff --git a/src/path.mli b/src/path.mli
index dd75b05..a6e582a 100644
--- a/src/path.mli
+++ b/src/path.mli
@@ -19,7 +19,7 @@ val isEmpty : local -> bool
 val child : 'a path -> Name.t -> 'a path
 val parent : local -> local
 val finalName : t -> Name.t option
-val deconstruct : t -> (Name.t * t) option
+val deconstruct : 'a path -> (Name.t * 'a path) option
 val deconstructRev : local -> (Name.t * local) option
 
 val fromString : string -> 'a path
diff --git a/src/remote.ml b/src/remote.ml
index 5f49f0d..16b6a15 100644
--- a/src/remote.ml
+++ b/src/remote.ml
@@ -960,8 +960,9 @@ let initConnection in_ch out_ch =
   checkHeader
     conn (Bytearray.create 1) 0 (String.length connectionHeader) >>= (fun () ->
   Lwt.ignore_result (receive conn);
-  negociateFlowControl conn >>= (fun () ->
-  Lwt.return conn))
+  (* Flow control negociation can be done asynchronously. *)
+  Lwt.ignore_result (negociateFlowControl conn);
+  Lwt.return conn)
 
 let inetAddr host =
   let targetHostEntry = Unix.gethostbyname host in
diff --git a/src/update.ml b/src/update.ml
index c3de39b..910d772 100644
--- a/src/update.ml
+++ b/src/update.ml
@@ -213,19 +213,26 @@ let archiveName fspath (v: archiveVersion): string * string =
    NoArchive appears only at root-level (indicated by [top]).  Property: Two
    archives of the same labeled-tree structure have the same hash-value.
    NB: [h] is the hash accumulator *)
-let rec checkArchive (top: bool) (path: Path.t) (arch: archive) (h: int): int =
+(* Note that we build the current path as a list of names, as this is
+   much cheaper than using values of type [Path.t] *)
+let rec checkArchive
+      (top: bool) (path: Name.t list) (arch: archive) (h: int): int =
   match arch with
     ArchiveDir (desc, children) ->
       begin match NameMap.validate children with
         `Ok ->
           ()
       | `Duplicate nm ->
+          let path =
+            List.fold_right (fun n p -> Path.child p n) path Path.empty in
           raise
             (Util.Fatal (Printf.sprintf
                            "Corrupted archive: \
                             the file %s occurs twice in path %s"
                            (Name.toString nm) (Path.toString path)));
       | `Invalid (nm, nm') ->
+          let path =
+            List.fold_right (fun n p -> Path.child p n) path Path.empty in
           raise
             (Util.Fatal (Printf.sprintf
                            "Corrupted archive: the files %s and %s are not \
@@ -236,7 +243,7 @@ let rec checkArchive (top: bool) (path: Path.t) (arch: archive) (h: int): int =
       NameMap.fold
         (fun n a h ->
            Uutil.hash2 (Name.hash n)
-                       (checkArchive false (Path.child path n) a h))
+                       (checkArchive false (n :: path) a h))
         children (Props.hash desc h)
   | ArchiveFile (desc, dig, _, ress) ->
       Uutil.hash2 (Hashtbl.hash dig) (Props.hash desc h)
@@ -1653,7 +1660,7 @@ let prepareCommitLocal (fspath, magic) =
      showArchive archive;
      Format.print_flush();
    **)
-  let archiveHash = checkArchive true Path.empty archive 0 in
+  let archiveHash = checkArchive true [] archive 0 in
   storeArchiveLocal
     (Os.fileInUnisonDir newName) root archive archiveHash magic;
   Lwt.return (Some archiveHash)