From 250074b37b8fb5e05d3d670312d39c69f59aa6d1 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Fri, 13 Mar 2026 14:10:09 +0000 Subject: [PATCH 1/2] meta: packaging fixes Signed-off-by: Pau Ruiz Safont --- dune-project | 1 + 1 file changed, 1 insertion(+) diff --git a/dune-project b/dune-project index e1e4354..3b36e21 100644 --- a/dune-project +++ b/dune-project @@ -1,2 +1,3 @@ (lang dune 2.7) +(name xapi-backtrace) (cram enable) From 23d608bfde7983eb606e29d8507d4dbf533fcdeb Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 16 Mar 2026 09:49:50 +0000 Subject: [PATCH 2/2] test: make tests pass on older ocaml versions The formatting of exceptions depends on the OCaml version. Hardcode the formatting for `Failure` exceptions, which are the only ones raised by the test executable. The match governing the formatting has been put at the end of the file to ensure that if the formatting code needs to be somehow changes, it won't affect the lines shown in the cram test any longer. Signed-off-by: Pau Ruiz Safont --- test/log.ml | 34 +++++++++++++++++++++------------- test/reraise.t | 4 ++-- 2 files changed, 23 insertions(+), 15 deletions(-) diff --git a/test/log.ml b/test/log.ml index 9ce569b..1a0bc00 100644 --- a/test/log.ml +++ b/test/log.ml @@ -39,17 +39,25 @@ let with_thread_associated_old desc f x = log_backtrace_exn exn bt ; raise exn -let with_thread_associated desc f x = - let print_backtrace = function - | Ok result -> - result - | Error (exn, bt) -> - output_log - (Printf.sprintf "%s failed with exception %s" desc - (Printexc.to_string exn) - ) ; - log_backtrace_exn exn bt ; - raise exn - in - let@ () = Backtrace.V2.with_backtraces ~finally:print_backtrace in +let rec with_thread_associated desc f x = + let@ () = Backtrace.V2.with_backtraces ~finally:(print_backtrace desc) in try f x with e -> Backtrace.is_important e ; raise e + +and print_backtrace desc = function + | Ok result -> + result + | Error ((Failure msg) as exn, bt) -> + (* stabilize output for Failure exceptions across compiler versions *) + output_log + (Printf.sprintf {|%s failed with exception Failure("%s")|} desc + msg + ) ; + log_backtrace_exn exn bt ; + raise exn + | Error (exn, bt) -> + output_log + (Printf.sprintf {|%s failed with exception %s|} desc + (Printexc.to_string exn) + ) ; + log_backtrace_exn exn bt ; + raise exn diff --git a/test/reraise.t b/test/reraise.t index 04831d1..a89c063 100644 --- a/test/reraise.t +++ b/test/reraise.t @@ -9,7 +9,7 @@ 1/4 raiser.exe Raised at file test/raiser.ml, line 1 2/4 raiser.exe Called from file test/raiser.ml, line 4 3/4 raiser.exe Called from file lib/backtrace.ml, line 251 - 4/4 raiser.exe Called from file test/log.ml, line 55 + 4/4 raiser.exe Called from file test/log.ml, line 44 $ ./raiser.exe -v1-with-backtrace @@ -23,5 +23,5 @@ 1/4 raiser.exe Raised at file test/raiser.ml, line 1 2/4 raiser.exe Called from file test/raiser.ml, line 6 3/4 raiser.exe Called from file test/raiser.ml, line 6 - 4/4 raiser.exe Called from file test/log.ml, line 55 + 4/4 raiser.exe Called from file test/log.ml, line 44