From f5252e98409f36211604df8b40a4575a4a0ea7d1 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sun, 20 Oct 2019 08:13:54 +0200 Subject: [PATCH] Misc.protect_refs: use Fun.protect to protect the backtrace Currently Fun.protect and Misc.try_finally can be used in code that tries carefully to preserve the first-failure backtrace, but Misc.protect_refs cannot. This PR fixes the discrepancy. See #9057 for a use-case. See the GPR ( https://github.com/ocaml/ocaml/pull/9060 ) for an in-depth discussion of the potential performance impact of this change. --- Changes | 3 +++ utils/misc.ml | 4 +--- utils/misc.mli | 3 ++- 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/Changes b/Changes index 8519e306617b..6539be278903 100644 --- a/Changes +++ b/Changes @@ -43,6 +43,9 @@ Working version (matching on the effects of a copmutation) in the typedtree. (Gabriel Scherer, review by Jacques Garrigue and Alain Frisch) +- #9060: ensure that Misc.protect_refs preserves backtraces + (Gabriel Scherer, review by Guillaume Munch-Maccagnoni and David Allsopp) + - #9078: make all compilerlibs/ available to ocamltest. (Gabriel Scherer, review by Sébastien Hinderer) diff --git a/utils/misc.ml b/utils/misc.ml index f42b79350461..5077a2b594c7 100644 --- a/utils/misc.ml +++ b/utils/misc.ml @@ -56,9 +56,7 @@ let protect_refs = fun refs f -> let backup = List.map (fun (R (r, _)) -> R (r, !r)) refs in set_refs refs; - match f () with - | x -> set_refs backup; x - | exception e -> set_refs backup; raise e + Fun.protect ~finally:(fun () -> set_refs backup) f (* List functions *) diff --git a/utils/misc.mli b/utils/misc.mli index 1e24039afd32..2f115d6b1bf0 100644 --- a/utils/misc.mli +++ b/utils/misc.mli @@ -82,7 +82,8 @@ type ref_and_value = R : 'a ref * 'a -> ref_and_value val protect_refs : ref_and_value list -> (unit -> 'a) -> 'a (** [protect_refs l f] temporarily sets [r] to [v] for each [R (r, v)] in [l] while executing [f]. The previous contents of the references is restored - even if [f] raises an exception. *) + even if [f] raises an exception, without altering the exception backtrace. +*) module Stdlib : sig module List : sig