Merge pull request xapi-project#9 from djs55/add-backtraces

Support reliable, cross-host, cross-process backtraces

.gitignore

@@ -0,0 +1,3 @@
+_build/
+setup.data
+setup.log

ChangeLog

@@ -1,5 +1,5 @@
-0.12.0 (26-Sep-2014):
-* Build on OS X
+0.12.0 (unreleased)
+* Depend on Backtrace from xapi-backtrace
 
 0.11.0 (30-May-2013):
 * Change Stringext module to Xstringext to avoid conflict with other packages

_oasis

@@ -1,17 +1,17 @@
 OASISFormat:  0.3
 Name:         stdext
-Version:      0.12.0
+Version:      0.11.0
 Synopsis:     Standard extension library
 License:      LGPL-2.1 with OCaml linking exception
 Authors:      various
-Copyrights:   (C) 2006-2014 Citrix
+Copyrights:   (C) 2012 Citrix
 BuildTools:   ocamlbuild
 Plugins:      DevFiles (0.3), META (0.3)
 
 Library stdext
   Path: lib
-  Modules: Arrayext, Backtrace, Base64, Bigbuffer, Config, Date, Either, Encodings, ExtentlistSet, Filenameext, Fring, Fun, Hashtblext, Int64ext, LazyList, Listext, Mapext, Monad, Opt, Pervasiveext, Qring, Range, Ring, Xstringext, Threadext, Trie, Unixext, VIO, Zerocheck
+  Modules: Arrayext, Base64, Bigbuffer, Config, Date, Either, Encodings, ExtentlistSet, Filenameext, Fring, Fun, Hashtblext, Int64ext, LazyList, Listext, Mapext, Monad, Opt, Pervasiveext, Qring, Range, Ring, Xstringext, Threadext, Trie, Unixext, VIO, Zerocheck
   CSources: blkgetsize_stubs.c, unixext_open_stubs.c, unixext_stubs.c, unixext_write_stubs.c, zerocheck_stub.c
-  BuildDepends: threads, uuidm, unix, fd-send-recv, bigarray
+  BuildDepends: threads, uuidm, unix, fd-send-recv, bigarray, sexplib, sexplib.syntax, xapi-backtrace
 
 

_tags

@@ -1,8 +1,9 @@
 # OASIS_START
-# DO NOT EDIT (digest: ad1a1bbbb71d472f0711580d2cc59333)
+# DO NOT EDIT (digest: 0b1ac2bd701986ac4e927661d05dbd2f)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
+true: annot, bin_annot
 <**/.svn>: -traverse
 <**/.svn>: not_hygienic
 ".bzr": -traverse
@@ -16,34 +17,52 @@
 # Library stdext
 "lib/stdext.cmxs": use_stdext
 <lib/stdext.{cma,cmxa}>: use_libstdext_stubs
-<lib/*.ml{,i}>: pkg_bigarray
-<lib/*.ml{,i}>: pkg_fd-send-recv
-<lib/*.ml{,i}>: pkg_threads
-<lib/*.ml{,i}>: pkg_unix
-<lib/*.ml{,i}>: pkg_uuidm
+<lib/*.ml{,i,y}>: pkg_bigarray
+<lib/*.ml{,i,y}>: pkg_fd-send-recv
+<lib/*.ml{,i,y}>: pkg_sexplib
+<lib/*.ml{,i,y}>: pkg_sexplib.syntax
+<lib/*.ml{,i,y}>: pkg_threads
+<lib/*.ml{,i,y}>: pkg_unix
+<lib/*.ml{,i,y}>: pkg_uuidm
+<lib/*.ml{,i,y}>: pkg_xapi-backtrace
 "lib/blkgetsize_stubs.c": pkg_bigarray
 "lib/blkgetsize_stubs.c": pkg_fd-send-recv
+"lib/blkgetsize_stubs.c": pkg_sexplib
+"lib/blkgetsize_stubs.c": pkg_sexplib.syntax
 "lib/blkgetsize_stubs.c": pkg_threads
 "lib/blkgetsize_stubs.c": pkg_unix
 "lib/blkgetsize_stubs.c": pkg_uuidm
+"lib/blkgetsize_stubs.c": pkg_xapi-backtrace
 "lib/unixext_open_stubs.c": pkg_bigarray
 "lib/unixext_open_stubs.c": pkg_fd-send-recv
+"lib/unixext_open_stubs.c": pkg_sexplib
+"lib/unixext_open_stubs.c": pkg_sexplib.syntax
 "lib/unixext_open_stubs.c": pkg_threads
 "lib/unixext_open_stubs.c": pkg_unix
 "lib/unixext_open_stubs.c": pkg_uuidm
+"lib/unixext_open_stubs.c": pkg_xapi-backtrace
 "lib/unixext_stubs.c": pkg_bigarray
 "lib/unixext_stubs.c": pkg_fd-send-recv
+"lib/unixext_stubs.c": pkg_sexplib
+"lib/unixext_stubs.c": pkg_sexplib.syntax
 "lib/unixext_stubs.c": pkg_threads
 "lib/unixext_stubs.c": pkg_unix
 "lib/unixext_stubs.c": pkg_uuidm
+"lib/unixext_stubs.c": pkg_xapi-backtrace
 "lib/unixext_write_stubs.c": pkg_bigarray
 "lib/unixext_write_stubs.c": pkg_fd-send-recv
+"lib/unixext_write_stubs.c": pkg_sexplib
+"lib/unixext_write_stubs.c": pkg_sexplib.syntax
 "lib/unixext_write_stubs.c": pkg_threads
 "lib/unixext_write_stubs.c": pkg_unix
 "lib/unixext_write_stubs.c": pkg_uuidm
+"lib/unixext_write_stubs.c": pkg_xapi-backtrace
 "lib/zerocheck_stub.c": pkg_bigarray
 "lib/zerocheck_stub.c": pkg_fd-send-recv
+"lib/zerocheck_stub.c": pkg_sexplib
+"lib/zerocheck_stub.c": pkg_sexplib.syntax
 "lib/zerocheck_stub.c": pkg_threads
 "lib/zerocheck_stub.c": pkg_unix
 "lib/zerocheck_stub.c": pkg_uuidm
+"lib/zerocheck_stub.c": pkg_xapi-backtrace
 # OASIS_STOP

lib/META

@@ -1,8 +1,9 @@
 # OASIS_START
-# DO NOT EDIT (digest: aeed1c526e0bfd4c0e4829294ebbc5b8)
-version = "0.12.0"
+# DO NOT EDIT (digest: 21fd61b70457600a802589019bd01d38)
+version = "0.11.0"
 description = "Standard extension library"
-requires = "threads uuidm unix fd-send-recv bigarray"
+requires =
+"threads uuidm unix fd-send-recv bigarray sexplib sexplib.syntax xapi-backtrace"
 archive(byte) = "stdext.cma"
 archive(byte, plugin) = "stdext.cma"
 archive(native) = "stdext.cmxa"

lib/encodings.ml

@@ -95,9 +95,9 @@ end
 
 module UTF8_CODEC (UCS_validator : UCS_VALIDATOR) = struct
 	let width_required_for_ucs_value value =
-		if value < 0x000080l (* 1 <<  7 *) then 1 else
-		if value < 0x000800l (* 1 << 11 *) then 2 else
-		if value < 0x010000l (* 1 << 16 *) then 3 else 4
+		if value < 0x000080l (* 1 lsl  7 *) then 1 else
+		if value < 0x000800l (* 1 lsl 11 *) then 2 else
+		if value < 0x010000l (* 1 lsl 16 *) then 3 else 4
 
 	(* === Decoding === *)
 

lib/pervasiveext.ml

@@ -15,15 +15,15 @@
  * Even if fct raises an exception, clean_f is applied
  *)
 
-let exnhook = ref None 
 
 let finally fct clean_f =
-	let result = try
-		fct ();
-	with
-		exn ->
-		  (match !exnhook with None -> () | Some f -> f exn);
-		  clean_f (); raise exn in
+	let result =
+		try
+			fct ();
+		with exn ->
+			Backtrace.is_important exn;
+			clean_f ();
+			raise exn in
 	clean_f ();
 	result
 

lib/pervasiveext.mli

@@ -11,8 +11,11 @@
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU Lesser General Public License for more details.
  *)
-val exnhook : (exn -> unit) option ref
+
 val finally : (unit -> 'a) -> (unit -> 'b) -> 'a
+(** [finally f g] returns [f ()] guaranteeing to run clean-up actions
+    [g ()] even if [f ()] throws an exception. *)
+
 val maybe_with_default : 'b -> ('a -> 'b) -> 'a option -> 'b
 val may : ('a -> 'b) -> 'a option -> 'b option
 val default : 'a -> 'a option -> 'a

lib/stdext.mldylib

@@ -0,0 +1,31 @@
+# OASIS_START
+# DO NOT EDIT (digest: 3ba17b3a67d7a4ec569fbc8550f6f99c)
+Arrayext
+Base64
+Bigbuffer
+Config
+Date
+Either
+Encodings
+ExtentlistSet
+Filenameext
+Fring
+Fun
+Hashtblext
+Int64ext
+LazyList
+Listext
+Mapext
+Monad
+Opt
+Pervasiveext
+Qring
+Range
+Ring
+Xstringext
+Threadext
+Trie
+Unixext
+VIO
+Zerocheck
+# OASIS_STOP

lib/stdext.mllib

@@ -1,7 +1,6 @@
 # OASIS_START
-# DO NOT EDIT (digest: c978081ca056d24ca2e8600834c60c52)
+# DO NOT EDIT (digest: 3ba17b3a67d7a4ec569fbc8550f6f99c)
 Arrayext
-Backtrace
 Base64
 Bigbuffer
 Config

lib/xstringext.ml

@@ -84,8 +84,9 @@ let strip predicate string =
 let escaped ?rules string = match rules with
 	| None -> String.escaped string
 	| Some rules ->
-		let aux h t = (try List.assoc h rules
-			       with Not_found -> of_char h) :: t in
+		let aux h t = (if List.mem_assoc h rules
+                               then List.assoc h rules
+			       else of_char h) :: t in
 		concat "" (fold_right aux string [])
 
 (** Take a predicate and a string, return a list of strings separated by
@@ -104,8 +105,18 @@ let split_f p str =
 	end  in
 	List.rev (List.map implode (alternate [] true (explode str)))
 
+let index_opt s c =
+	let rec loop i =
+		if String.length s = i
+		then None
+		else
+			if s.[i] = c
+			then Some i
+			else loop (i + 1) in
+	loop 0
+
 let rec split ?limit:(limit=(-1)) c s =
-	let i = try String.index s c with Not_found -> -1 in
+	let i = match index_opt s c with | Some x -> x | None -> -1 in
 	let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in
 	if i = -1 || nlimit = 0 then
 		[ s ]