From 733e2531b3a88ff86ca38c1ccbadea8e559a86cc Mon Sep 17 00:00:00 2001
From: Josh Berdine <jjb@fb.com>
Date: Fri, 9 Dec 2016 16:35:00 -0800
Subject: [PATCH] Protect against use of Core functions that add exception
 handlers that exit

Summary:
Several Core functions silently wrap argument functions with catch-all
exception handlers that exit.  This diff protects against these from
ever being used by deprecating them, which causes compilation failure if
they are used.

Reviewed By: jvillard

Differential Revision: D4271781

fbshipit-source-id: a096171
---
 infer/src/base/IStd.ml  |  6 +++--
 infer/src/base/IStd.mli | 58 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 62 insertions(+), 2 deletions(-)
 create mode 100644 infer/src/base/IStd.mli

diff --git a/infer/src/base/IStd.ml b/infer/src/base/IStd.ml
index d53c89b67..2b2b56732 100644
--- a/infer/src/base/IStd.ml
+++ b/infer/src/base/IStd.ml
@@ -25,7 +25,9 @@ module Sys = struct
     with Unix.Unix_error _ -> `Unknown
 end
 
-include (Core.Std : module type of Core.Std with module Sys := Sys)
+include
+  (Core.Std : module type of Core.Std
+   with module Sys := Sys)
 
 let ( @ ) = Caml.List.append
 
@@ -34,7 +36,7 @@ let ( @ ) = Caml.List.append
 module IntSet = Caml.Set.Make(Int)
 
 
-(** Compare police: generic compare mostly disabled. *)
+(* Compare police: generic compare mostly disabled. *)
 let compare = No_polymorphic_compare.compare
 let equal = No_polymorphic_compare.equal
 
diff --git a/infer/src/base/IStd.mli b/infer/src/base/IStd.mli
new file mode 100644
index 000000000..97c63da00
--- /dev/null
+++ b/infer/src/base/IStd.mli
@@ -0,0 +1,58 @@
+(*
+ * Copyright (c) 2016 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ *)
+
+open Core.Std
+
+(* Core's Gc and Signal modules wrap handler functions in catch-all exception handlers that
+   exit. This defeats the timeout mechanisms. So deprecate the offending functions to cause a
+   compilation failure if they are used. *)
+
+module Gc : sig
+  module Expert : sig
+    module Alarm : sig
+      include module type of Gc.Expert.Alarm
+      val create : (unit -> unit) -> t
+      [@@deprecated "Adds a catch-all exception handler that exits, use [Caml.Gc.create_alarm]"]
+    end
+    include module type of Gc.Expert with module Alarm := Alarm
+    val add_finalizer : 'a Heap_block.t -> ('a Heap_block.t -> unit) -> unit
+    [@@deprecated "Adds a catch-all exception handler that exits, use [Caml.Gc.finalise]"]
+    val add_finalizer_exn : 'a -> ('a -> unit) -> unit
+    [@@deprecated "Adds a catch-all exception handler that exits, use [Caml.Gc.finalise]"]
+  end
+  include (module type of Gc with module Expert := Expert)
+end
+
+module Signal : sig
+  module Expert : sig
+    include module type of Signal.Expert
+    val signal : Signal.t -> behavior -> behavior
+    [@@deprecated "Adds a catch-all exception handler that exits, use [Caml.Sys.signal]"]
+    val set : Signal.t -> behavior -> unit
+    [@@deprecated "Adds a catch-all exception handler that exits, use [Caml.Sys.set_signal]"]
+    val handle : Signal.t -> (Signal.t -> unit) -> unit
+    [@@deprecated "Adds a catch-all exception handler that exits, use [Caml.Sys.set_signal]"]
+  end
+  include (module type of Signal with module Expert := Expert)
+end
+
+include
+  (module type of Core.Std
+    with module Gc := Gc
+    and module Signal := Signal)
+
+module IntSet : Caml.Set.S with type elt = Int.t
+
+(* Compare police: generic compare mostly disabled. *)
+val compare : No_polymorphic_compare.compare
+val equal : No_polymorphic_compare.compare
+
+val failwithf : ('a, Format.formatter, unit, 'b) format4 -> 'a
+
+val invalid_argf : ('a, Format.formatter, unit, 'b) format4 -> 'a