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

[bcpierce at seas.upenn.edu]

Author: bcpierce
Date: 2012-04-24 12:19:19 -0400 (Tue, 24 Apr 2012)
New Revision: 494

Modified:
   trunk/src/Makefile.OCaml
   trunk/src/RECENTNEWS
   trunk/src/main.ml
   trunk/src/mkProjectInfo.ml
   trunk/src/uicommon.ml
Log:
* Display full stack backtraces when printing exceptions, per comment
  from Jerome

Modified: trunk/src/Makefile.OCaml
===================================================================
--- trunk/src/Makefile.OCaml	2012-04-06 15:11:54 UTC (rev 493)
+++ trunk/src/Makefile.OCaml	2012-04-24 16:19:19 UTC (rev 494)
@@ -91,6 +91,9 @@
 ####################################################################
 ### Default parameters
 
+# Generate backtrace information for exceptions
+CAMLFLAGS+=-g
+
 INCLFLAGS=-I lwt -I ubase -I system
 CAMLFLAGS+=$(INCLFLAGS)
 CAMLFLAGS+=-I system/$(SYSTEM) -I lwt/$(SYSTEM)

Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS	2012-04-06 15:11:54 UTC (rev 493)
+++ trunk/src/RECENTNEWS	2012-04-24 16:19:19 UTC (rev 494)
@@ -1,11 +1,12 @@
-CHANGES FROM VERSION 2.45.1
+CHANGES FROM VERSION 2.45.6
 
-- fixed a bug in the lookup of the host name on the server
-
+* Display full stack backtraces when printing exceptions, per comment
+  from Jerome
 -------------------------------
-CHANGES FROM VERSION 2.45.-1
+CHANGES FROM VERSION 2.45.1
 
-* Bit more preparation for beta release
+* Display full stack backtraces when printing exceptions, per comment
+  from Jerome
 
+- fixed a bug in the lookup of the host name on the server
 
--------------------------------

Modified: trunk/src/main.ml
===================================================================
--- trunk/src/main.ml	2012-04-06 15:11:54 UTC (rev 493)
+++ trunk/src/main.ml	2012-04-24 16:19:19 UTC (rev 494)
@@ -125,14 +125,21 @@
     (function Uicommon.Text -> ["text"]
       | Uicommon.Graphic -> ["graphic"]);;
 
-let init() = begin
+let catch_all f = 
+  try
+    Util.msg "Starting catch_all...\n";
+    f ();
+    Util.msg "Done catch_all...\n";
+  with e ->
+    Util.msg "Unison failed: %s\n" (Uicommon.exn2string e); exit 1;;
+
+let init () = begin
   ignore (Gc.set {(Gc.get ()) with Gc.max_overhead = 150});
+  (* Make sure exception descriptions include backtraces *)
+  Printexc.record_backtrace true;
 
   let argv = Prefs.scanCmdLine Uicommon.usageMsg in
 
-  let catch_all f =
-    (try f () with e -> Util.msg "%s\n" (Uicommon.exn2string e); exit 1) in
-
   (* Print version if requested *)
   if Util.StringMap.mem versionPrefName argv then begin
     Printf.printf "%s version %s\n" Uutil.myName Uutil.myVersion;
@@ -183,7 +190,7 @@
   with Not_found -> () end;
 
   (* Install an appropriate function for finding preference files.  (We put
-     this in Util just because the Prefs module lives below the Os module in the
+     this here just because the Prefs module lives below the Os module in the
      dependency hierarchy, so Prefs can't call Os directly.) *)
   Util.supplyFileInUnisonDirFn 
     (fun n -> Os.fileInUnisonDir(n));
@@ -216,7 +223,7 @@
 end
 
 (* non-GUI startup for Mac GUI version *)
-let nonGuiStartup() = begin
+let nonGuiStartup () = begin
   let argv = init() in (* might not return *)
   (* if it returns start a UI *)
   (try
@@ -228,7 +235,7 @@
   ()
 end
 
-module Body = functor(Ui : Uicommon.UI) -> struct
+module Body = functor (Ui : Uicommon.UI) -> struct
   let argv = init() in (* might not return *)
   (* if it returns start a UI *)
   Ui.start 

Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml	2012-04-06 15:11:54 UTC (rev 493)
+++ trunk/src/mkProjectInfo.ml	2012-04-24 16:19:19 UTC (rev 494)
@@ -68,3 +68,4 @@
 
 
 
+

Modified: trunk/src/uicommon.ml
===================================================================
--- trunk/src/uicommon.ml	2012-04-06 15:11:54 UTC (rev 493)
+++ trunk/src/uicommon.ml	2012-04-24 16:19:19 UTC (rev 494)
@@ -309,20 +309,24 @@
   let (r1, action, r2, path) = reconItem2stringList oldPath theRI in
   Format.sprintf "%s %s %s %s %s" r1 (action2niceString action) r2 status path
 
-let exn2string = function
-    Sys.Break      -> "Terminated!"
-  | Util.Fatal(s)  -> Printf.sprintf "Fatal error: %s" s
-  | Util.Transient(s) -> Printf.sprintf "Error: %s" s
-  | Unix.Unix_error (err, fun_name, arg) ->
-      Printf.sprintf "Uncaught unix error: %s failed%s: %s%s"
-        fun_name
-        (if String.length arg > 0 then Format.sprintf " on \"%s\"" arg else "")
-        (Unix.error_message err)
-        (match err with
-           Unix.EUNKNOWNERR n -> Format.sprintf " (code %d)" n
-         | _                  -> "")
-  | Invalid_argument s -> Printf.sprintf "Invalid argument: %s" s
-  | other -> Printf.sprintf "Uncaught exception %s" (Printexc.to_string other)
+let exn2string e =
+  match e with
+     Sys.Break      -> "Terminated!"
+   | Util.Fatal(s)  -> Printf.sprintf "Fatal error: %s" s
+   | Util.Transient(s) -> Printf.sprintf "Error: %s" s
+   | Unix.Unix_error (err, fun_name, arg) ->
+       Printf.sprintf "Uncaught unix error: %s failed%s: %s%s\n%s"
+         fun_name
+         (if String.length arg > 0 then Format.sprintf " on \"%s\"" arg else "")
+         (Unix.error_message err)
+         (match err with
+            Unix.EUNKNOWNERR n -> Format.sprintf " (code %d)" n
+          | _                  -> "")
+         (Printexc.get_backtrace ())
+   | Invalid_argument s ->
+       Printf.sprintf "Invalid argument: %s\n%s" s (Printexc.get_backtrace ())
+   | other -> Printf.sprintf "Uncaught exception %s\n%s"
+       (Printexc.to_string other) (Printexc.get_backtrace ())
 
 (* precondition: uc = File (Updates(_, ..) on both sides *)
 let showDiffs ri printer errprinter id =