Bug#528603: Patch to add support for backtraces to oUnit

[Michael Ekstrand]

Attached is a patch for oUnit which does the following:

 - Augments RError and RFailure with an additional string option element
   to store a backtrace.
 - Adds code to test runner to store the backtrace in the result if
   backtraces are enabled.
 - Adds code to reporting to print backtraces with the error/failure
   report.
 - Modifies the Makefile to compile everything with -g (so stack traces
   don't get lost in oUnit).

- Michael

-- 
mouse, n: A device for pointing at the xterm in which you want to type.
Confused by the strange files?  I cryptographically sign my messages.
For more information see <http://www.elehack.net/resources/gpg>.

pgpWJAUZLuFsO.pgp
Description: PGP signature

Print backtraces for errors and failures

Index: ounit-dev/oUnit.ml
===================================================================
--- ounit-dev.orig/oUnit.ml	2009-05-15 15:59:37.000000000 -0500
+++ ounit-dev/oUnit.ml	2009-05-15 16:00:23.000000000 -0500
@@ -225,8 +225,8 @@
 (* The possible test results *)
 type test_result =
     RSuccess of path
-  | RFailure of path * string
-  | RError of path * string
+  | RFailure of path * string * string option
+  | RError of path * string * string option
   | RSkip of path * string
   | RTodo of path * string
 
@@ -259,15 +259,18 @@
 
 let result_path = function
     RSuccess path 
-  | RError (path, _) 
-  | RFailure (path, _) 
+  | RError (path, _, _)
+  | RFailure (path, _, _)
   | RSkip (path, _)
   | RTodo (path, _) -> path
 
 let result_msg = function
     RSuccess _ -> "Success"
-  | RError (_, msg) 
-  | RFailure (_, msg) 
+  | RError (_, msg, Some trace)
+  | RFailure (_, msg, Some trace) ->
+      String.concat "\n" [msg; trace]
+  | RError (_, msg, None)
+  | RFailure (_, msg, None)
   | RSkip (_, msg)
   | RTodo (_, msg) -> msg
 
@@ -294,10 +297,16 @@
       f ();
       RSuccess path
     with
-	Failure s -> RFailure (path, s)
+	Failure s -> RFailure (path, s,
+                               if Printexc.backtrace_status () then
+                                 Some (Printexc.get_backtrace ())
+                               else None)
       | Skip s -> RSkip (path, s)
       | Todo s -> RTodo (path, s)
-      | s -> RError (path, (Printexc.to_string s))
+      | s -> RError (path, (Printexc.to_string s),
+                     if Printexc.backtrace_status () then
+                       Some (Printexc.get_backtrace ())
+                     else None)
   in
   let rec run_test path results test = 
     match test with 
@@ -332,9 +341,9 @@
   let string_of_result = function
       RSuccess _ ->
 	if verbose then "ok\n" else "."
-    | RFailure (_, _) ->
+    | RFailure (_, _, _) ->
 	if verbose then "FAIL\n" else "F"
-    | RError (_, _) -> 
+    | RError (_, _, _) ->
 	if verbose then "ERROR\n" else "E"
     | RSkip (_, _) ->
 	if verbose then "SKIP\n" else "S"
Index: ounit-dev/oUnit.mli
===================================================================
--- ounit-dev.orig/oUnit.mli	2009-05-15 15:59:37.000000000 -0500
+++ ounit-dev/oUnit.mli	2009-05-15 16:00:23.000000000 -0500
@@ -156,8 +156,8 @@
 (** The possible results of a test *)
 type test_result =
     RSuccess of path
-  | RFailure of path * string
-  | RError of path * string
+  | RFailure of path * string * string option
+  | RError of path * string * string option
   | RSkip of path * string
   | RTodo of path * string
 
Index: ounit-dev/Makefile
===================================================================
--- ounit-dev.orig/Makefile	2009-05-15 15:59:37.000000000 -0500
+++ ounit-dev/Makefile	2009-05-15 16:00:23.000000000 -0500
@@ -10,8 +10,8 @@
 XARCHIVE=$(ARCHIVE:.cma=.cmxa)
 
 OCAMLRUN=ocamlrun
-OCAMLC=ocamlc
-OCAMLOPT=ocamlopt
+OCAMLC=ocamlc -g
+OCAMLOPT=ocamlopt -g
 OCAMLDEP=ocamldep
 MKLIB=ocamlmklib
 OCAMLDOC=ocamldoc