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

vouillon at seas.upenn.edu vouillon at seas.upenn.edu
Mon Apr 30 12:18:36 EDT 2012


Author: vouillon
Date: 2012-04-30 12:18:35 -0400 (Mon, 30 Apr 2012)
New Revision: 495

Modified:
   trunk/src/RECENTNEWS
   trunk/src/mkProjectInfo.ml
   trunk/src/remote.ml
   trunk/src/transfer.ml
Log:
* Added some debugging code in transfer.ml


Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS	2012-04-24 16:19:19 UTC (rev 494)
+++ trunk/src/RECENTNEWS	2012-04-30 16:18:35 UTC (rev 495)
@@ -1,3 +1,8 @@
+CHANGES FROM VERSION 2.45.7
+
+* Added some debugging code in transfer.ml
+
+-------------------------------
 CHANGES FROM VERSION 2.45.6
 
 * Display full stack backtraces when printing exceptions, per comment

Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml	2012-04-24 16:19:19 UTC (rev 494)
+++ trunk/src/mkProjectInfo.ml	2012-04-30 16:18:35 UTC (rev 495)
@@ -69,3 +69,4 @@
 
 
 
+

Modified: trunk/src/remote.ml
===================================================================
--- trunk/src/remote.ml	2012-04-24 16:19:19 UTC (rev 494)
+++ trunk/src/remote.ml	2012-04-30 16:18:35 UTC (rev 495)
@@ -896,7 +896,10 @@
            Lwt_util.run_in_region streamReg 1
              (fun () -> sender (fun v -> client conn id v)))
         (fun v -> ping conn id >>= fun () -> Lwt.return v)
-        (fun e -> ping conn id >>= fun () -> Lwt.fail e)
+        (fun e ->
+           debugE (fun () ->
+             Util.msg "Pinging remote end after streaming error\n");
+           ping conn id >>= fun () -> Lwt.fail e)
     end
 
 let commandAvailable =

Modified: trunk/src/transfer.ml
===================================================================
--- trunk/src/transfer.ml	2012-04-24 16:19:19 UTC (rev 494)
+++ trunk/src/transfer.ml	2012-04-30 16:18:35 UTC (rev 495)
@@ -147,8 +147,12 @@
     return ()
 
 let pushEOF q showProgress transmit =
+  if Trace.enabled "rsynctoken" then
+    debugToken (fun() ->
+      Util.msg "pushing EOF (pos:%d/%d)\n" q.pos queueSize);
   flushQueue q showProgress transmit
     (q.pos + 1 > queueSize) >>= (fun () ->
+  assert (q.pos < queueSize);
   q.data.{q.pos} <- 'E';
   q.pos <- q.pos + 1;
   q.previous <- `None;
@@ -156,7 +160,11 @@
 
 let rec pushString q id transmit s pos len =
   flushQueue q id transmit (q.pos + len + 3 > queueSize) >>= fun () ->
+  if Trace.enabled "rsynctoken" then
+    debugToken (fun() ->
+      Util.msg "pushing string (pos:%d/%d len:%d)\n" q.pos queueSize len);
   let l = min len (queueSize - q.pos - 3) in
+  assert (l > 0);
   q.data.{q.pos} <- 'S';
   encodeInt2 q.data (q.pos + 1) l;
   Bytearray.blit_from_string s pos q.data (q.pos + 3) l;
@@ -169,8 +177,13 @@
     return ()
 
 let growString q id transmit len' s pos len =
+  if Trace.enabled "rsynctoken" then
+    debugToken (fun() ->
+      Util.msg "growing string (pos:%d/%d len:%d+%d)\n"
+        q.pos queueSize len' len);
   let l = min (queueSize - q.pos) len in
   Bytearray.blit_from_string s pos q.data q.pos l;
+  assert (q.pos - len' - 3 >= 0);
   assert (q.data.{q.pos - len' - 3} = 'S');
   assert (decodeInt2 q.data (q.pos - len' - 2) = len');
   let len'' = len' + l in
@@ -185,6 +198,10 @@
 
 let pushBlock q id transmit pos =
   flushQueue q id transmit (q.pos + 5 > queueSize) >>= (fun () ->
+  if Trace.enabled "rsynctoken" then
+    debugToken (fun() ->
+      Util.msg "pushing block (pos:%d/%d)\n" q.pos queueSize);
+  assert (q.pos + 5 <= queueSize);
   q.data.{q.pos} <- 'B';
   encodeInt3 q.data (q.pos + 1) pos;
   encodeInt1 q.data (q.pos + 4) 1;
@@ -194,6 +211,10 @@
   return ())
 
 let growBlock q id transmit pos =
+  if Trace.enabled "rsynctoken" then
+    debugToken (fun() ->
+      Util.msg "growing blocks (pos:%d/%d)\n" q.pos queueSize);
+  assert (q.pos >= 5);
   let count = decodeInt1 q.data (q.pos - 1) in
   assert (q.data.{q.pos - 5} = 'B');
   assert (decodeInt3 q.data (q.pos - 4) + count = pos);
@@ -642,8 +663,10 @@
        fingerprintMatchRec checksums pos fp i)
     in
     let fingerprintMatch k fp =
-      fingerprintMatchRec sigs.strongChecksum (k * sigs.checksumSize)
-        fp sigs.checksumSize
+      let pos = k * sigs.checksumSize in
+      assert
+        (pos + sigs.checksumSize <= Bigarray.Array1.dim sigs.strongChecksum);
+      fingerprintMatchRec sigs.strongChecksum pos fp sigs.checksumSize
     in
 
     (* Create the compression buffer *)



More information about the Unison-hackers mailing list