blob: 4e1382e8aa58244eecfdcd87f476c3fef077d6fd (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
From cba80ebe02962504fbe404b1baf484a5000f44b4
From: Jeremie Dimino <jdimino@janestreet.com>
Date: Tue, 12 Jul 2016 17:08:10 +0100
Subject: [PATCH] 114.01+04
--- lib/conv.ml.orig 2016-03-09 15:44:55 UTC
+++ lib/conv.ml
@@ -185,7 +185,7 @@ module Exn_converter = struct
(* [Obj.extension_id] works on both the exception itself, and the extension slot of the
exception. *)
- let rec clean_up_handler (slot : Obj.t) =
+ let rec clean_up_handler (slot : extension_constructor) =
let id = Obj.extension_id slot in
let old_exn_id_map = !exn_id_map in
let new_exn_id_map = Exn_ids.remove id old_exn_id_map in
@@ -196,7 +196,7 @@ module Exn_converter = struct
exn_id_map := new_exn_id_map
let add_auto ?(finalise = true) exn sexp_of_exn =
- let id = Obj.extension_id exn in
+ let id = Obj.extension_id (Obj.extension_constructor exn) in
let rec loop () =
let old_exn_id_map = !exn_id_map in
let new_exn_id_map = Exn_ids.add id sexp_of_exn old_exn_id_map in
@@ -205,13 +205,18 @@ module Exn_converter = struct
loop ()
else begin
exn_id_map := new_exn_id_map;
- if finalise then Gc.finalise clean_up_handler (Obj.extension_slot exn)
+ if finalise then
+ try
+ Gc.finalise clean_up_handler (Obj.extension_constructor exn)
+ with Invalid_argument _ ->
+ (* Pre-allocated extension constructors cannot be finalised *)
+ ()
end
in
loop ()
let find_auto exn =
- let id = Obj.extension_id exn in
+ let id = Obj.extension_id (Obj.extension_constructor exn) in
match Exn_ids.find id !exn_id_map with
| exception Not_found -> None
| sexp_of_exn -> Some (sexp_of_exn exn)
|
