[Mldonkey-commits] mldonkey distrib/ChangeLog src/utils/cdk/printe...

[mldonkey-commits]

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Changes by:     spiralvoice <spiralvoice>       14/02/23 18:16:44

Modified files:
        distrib        : ChangeLog 
        src/utils/cdk  : printexc2.ml printexc2.mli 

Log message:
        patch #8330

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1589&r2=1.1590
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/cdk/printexc2.ml?cvsroot=mldonkey&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/cdk/printexc2.mli?cvsroot=mldonkey&r1=1.2&r2=1.3

Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1589
retrieving revision 1.1590
diff -u -b -r1.1589 -r1.1590
--- distrib/ChangeLog   23 Feb 2014 18:16:11 -0000      1.1589
+++ distrib/ChangeLog   23 Feb 2014 18:16:44 -0000      1.1590
@@ -15,6 +15,7 @@
 =========
 
 2014/02/23:
+8330: printexc2: reduce complexity, drop unused code (ygrek)
 8329: printf2: reduce complexity, use Printf.ksprintf (ygrek)
 8328: gettext: reduce complexity, drop unused code (ygrek)
 8327: GTK2 GUI: fix wrong url on splash screen (ygrek)

Index: src/utils/cdk/printexc2.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/printexc2.ml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- src/utils/cdk/printexc2.ml  3 Apr 2006 20:50:09 -0000       1.5
+++ src/utils/cdk/printexc2.ml  23 Feb 2014 18:16:44 -0000      1.6
@@ -20,69 +20,9 @@
 open Printf2
 open Printf
 
-let locfmt =
-  Obj.magic (match Sys.os_type with
-  | "MacOS" -> "File \"%s\"; line %d; characters %d to %d ### %s"
-  | _ -> "File \"%s\", line %d, characters %d-%d: %s")
-;;
-
-let field x i =
-  let f = Obj.field x i in
-  if not (Obj.is_block f) then
-    sprintf "%d" (Obj.magic f : int)           (* can also be a char *)
-  else if Obj.tag f = Obj.string_tag then
-    sprintf "\"%s\"" (String.escaped (Obj.magic f : string))
-  else if Obj.tag f = Obj.double_tag then
-    string_of_float (Obj.magic f : float)
-  else
-    "_"
-;;
-let rec other_fields x i =
-  if i >= Obj.size x then ""
-  else sprintf ", %s%s" (field x i) (other_fields x (i+1))
-;;
-let fields x =
-  match Obj.size x with
-  | 0 -> ""
-  | 1 -> ""
-  | 2 -> sprintf "(%s)" (field x 1)
-  | n -> sprintf "(%s%s)" (field x 1) (other_fields x 2)
-;;
-
-let printers = ref []
-
-let rec check exn printers =
-  match printers with
-    [] -> raise Not_found
-  | printer :: printers ->
-      try printer exn with _ ->
-          check exn printers
-
 let to_string = function
-  | Out_of_memory -> "Out of memory";
-  | Stack_overflow -> "Stack overflow";
-  | Match_failure(file, first_char, last_char) ->
-      sprintf locfmt file 0 first_char last_char "Pattern matching failed";
-  | Assert_failure(file, first_char, last_char) ->
-      sprintf locfmt file 0 first_char last_char "Assertion failed";
-  | x ->
-      try
-        check x !printers
-      with _ ->
-      let x = Obj.repr x in
-      let constructor = (Obj.magic(Obj.field (Obj.field x 0) 0) : string) in
-      constructor ^ (fields x)
-;;
-
-let print fct arg =
-  try
-    fct arg
-  with x ->
-    eprintf "Uncaught exception: %s\n" (to_string x);
-    flush stderr;
-    raise x
-
-let register_exn f = printers := f :: !printers
+  | Unix.Unix_error (e, f, arg) -> sprintf "%s failed%s: %s" f (if arg = "" 
then "" else " on " ^ arg) (Unix.error_message e)
+  | exn -> Printexc.to_string exn
 
 let catch s f x =
   try f x with
@@ -93,18 +33,3 @@
   try f x y with
     e -> 
       lprintf_nl "Uncaught exception in %s: %s" s (to_string e)
-
-let vcatchexn s f =
-  try Some (f ()) with
-    e -> 
-      lprintf_nl "Uncaught exception in %s: %s" s (to_string e);
-      None
-
-let _ =
-  register_exn (fun e ->
-      match e with
-        Unix.Unix_error (e, f, arg) ->
-          Printf.sprintf "%s failed%s: %s" f (if arg = "" then "" else
-              " on " ^ arg) (Unix.error_message e)
-          | _ -> raise e
-  )

Index: src/utils/cdk/printexc2.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/printexc2.mli,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- src/utils/cdk/printexc2.mli 30 Jan 2004 06:11:07 -0000      1.2
+++ src/utils/cdk/printexc2.mli 23 Feb 2014 18:16:44 -0000      1.3
@@ -20,36 +20,11 @@
 (* Module [Printexc2]: facilities for printing exceptions *)
 
 val to_string : exn -> string
-        (* [Printexc2.to_string e] returns a string representation of
-           the exception [e]. *)
-
-val printers : (exn -> string) list ref
-  
-
-val print: ('a -> 'b) -> 'a -> 'b
-        (* [Printexc2.print fn x] applies [fn] to [x] and returns the result.
-           If the evaluation of [fn x] raises any exception, the
-           name of the exception is printed on standard error output,
-           and the exception is raised again.
-           The typical use is to catch and report exceptions that
-           escape a function application. *)
-
-val register_exn : (exn -> string) -> unit
-(*d [register_exn printer] registers a printer for user-defined 
-exceptions. [printer] is a function which takes an exception as argument
-and converts it to a string. If it cannot convert the exception, it should
-raise it again. *)
+(** [Printexc2.to_string e] returns a string representation of the exception 
[e]. *)
   
 val catch : string -> ('a -> unit) -> 'a -> unit
 val catch2 : string -> ('a -> 'b -> unit) -> 'a -> 'b -> unit
-(*d [catch msg f x] executes the function [f] and returns unit. If an 
-exception is raised during the execution of [f], the message [msg] is 
+(** [catch msg f x] executes the function [f] and returns unit. If an 
+    exception is raised during the execution of [f], the message [msg] is 
     printed on standard output with the exception using [printexn], and unit
     is returned. *)
-
-val vcatchexn : string -> (unit -> 'a) -> 'a option
-(*d [vcatchexn msg f] executes the function [f] and returns (Some [v]) if 
-[v] is the value returned by [f]. If an 
-exception is raised during the execution of [f], the message is printed
-    on standard output with the exception using [printexn], and 
-  None is returned. *)