avoid possible double frees (#4)

* avoid possible double frees

* check for use after free in more places

* add gc test case, update changes

.gitignore

@@ -2,4 +2,5 @@ target
 Cargo.lock
 example.c
 example.h
-example.json
+example.json
+_build

CHANGES.md

@@ -1,6 +1,11 @@
-## 0.2.6 (Unreleased)
+## 0.2.7
+
+- Fixed possible double frees when GC is triggered after `free` has already been called
+
+## 0.2.6
 
 - Implement `std::error::Error` for generated `Error` type
+- Added support for HIP backend 
 
 ## 0.2.5
 

examples/ocaml/test/test.ml

@@ -1,6 +1,16 @@
 open Example
 open Bigarray
 
+(* Try to trigger garbage collector *)
+let () =
+  let ctx = Context.v
+              ~debug:false ~log:false ~profile:false ~auto_sync:true () in
+  for i = 0 to 1000 do
+    let a = Genarray.init Float64 c_layout [| 100; 100 |] (fun _ -> Float.of_int i) in
+    let p = Array_f64_2d.v ctx a in
+    Array_f64_2d.free p
+  done
+
 let () =
   (* binary_search *)
   let ctx = Context.v ~debug:true ~profile:true ~log:true () in
@@ -22,6 +32,13 @@ let () =
   Array_f64_2d.free out;
   Array_f64_2d.free arr;
 
+  let () = 
+    try
+      let _ = Array_f64_2d.get out in
+      assert false
+    with Error (UseAfterFree `array) -> print_endline "Detected use after free"
+  in
+
   (* tup_mul *)
   let number = Number.v ctx 2.5 in
   let data3 = [| 0.0; 1.0; 2.0; 3.0; 4.0; 5.0; 6.0; 7.0; 8.0; 9.0 |] in

src/generate/templates/ocaml/array.ml

@@ -5,20 +5,26 @@ module {module_name} = struct
 
   let kind = {ba_kind}
 
-  let free t = ignore (Bindings.futhark_free_{elemtype}_{rank}d t.ctx.Context.handle t.ptr)
+  let free t =
+    if not t.array_free && not t.ctx.Context.context_free then
+      let () = ignore (Bindings.futhark_free_{elemtype}_{rank}d t.ctx.Context.handle t.ptr) in
+      t.array_free <- true
 
   let cast x =
     coerce (ptr void) (ptr {ocaml_ctype}) (to_voidp x)
 
   let v ctx ba =
+    check_use_after_free `context ctx.Context.context_free;
     let dims = Genarray.dims ba in
     let ptr = Bindings.futhark_new_{elemtype}_{rank}d ctx.Context.handle (cast @@ bigarray_start genarray ba) {dim_args} in
     if is_null ptr then raise (Error NullPtr);
     Context.auto_sync ctx;
-    let t = {{ ptr; ctx; shape = dims; }} in
+    let t = {{ ptr; ctx; shape = dims; array_free = false }} in
     Gc.finalise free t; t
 
   let values t ba =
+    check_use_after_free `context t.ctx.Context.context_free;
+    check_use_after_free `array t.array_free;
     let dims = Genarray.dims ba in
     let a = Array.fold_left ( * ) 1 t.shape in
     let b = Array.fold_left ( * ) 1 dims in
@@ -62,9 +68,10 @@ module {module_name} = struct
     Array.init {rank} (fun i -> Int64.to_int !@ (s +@ i))
 
   let of_ptr ctx ptr =
+    check_use_after_free `context ctx.Context.context_free;
     if is_null ptr then raise (Error NullPtr);
     let shape = ptr_shape ctx.Context.handle ptr in
-    let t = {{ ptr; ctx; shape }} in
+    let t = {{ ptr; ctx; shape; array_free = false }} in
     Gc.finalise free t; t
 
   let _ = of_ptr

src/generate/templates/ocaml/bindings.ml

@@ -32,12 +32,19 @@ type error =
   | InvalidShape of int * int
   | NullPtr
   | Code of int
+  | UseAfterFree of [`context | `array | `opaque]
 
 exception Error of error
 
+let check_use_after_free t b = if b then raise (Error (UseAfterFree t))
+
 let () = Printexc.register_printer (function
   | Error (InvalidShape (a, b)) -> Some (Printf.sprintf "futhark error: invalid shape, expected %d but got %d" a b)
   | Error NullPtr -> Some "futhark error: null pointer"
-  | Error (Code c) -> Some (Printf.sprintf "futhark error: code %d" c) | _ -> None)
+  | Error (Code c) -> Some (Printf.sprintf "futhark error: code %d" c) 
+  | Error (UseAfterFree `context) -> Some "futhark: context used after beeing freed"
+  | Error (UseAfterFree `array) -> Some "futhark: array used after beeing freed"
+  | Error (UseAfterFree `opaque) -> Some "futhark: opqaue value used after beeing freed"
+  | _ -> None)
 
 

src/generate/templates/ocaml/bindings.mli

@@ -5,5 +5,6 @@ type error =
   | InvalidShape of int * int 
   | NullPtr 
   | Code of int
+  | UseAfterFree of [`context | `array | `opaque]
 
 exception Error of error

src/generate/templates/ocaml/context.ml

@@ -1,13 +1,14 @@
 open Bigarray
 
 module Context = struct
-  type t = {{ handle: unit ptr; config: unit ptr; cache_file: string option; auto_sync: bool }}
-
-  let free t = 
-    ignore (Bindings.futhark_context_sync t.handle);
-    ignore (Bindings.futhark_context_free t.handle);
-    ignore (Bindings.futhark_context_config_free t.config)
+  type t = {{ handle: unit ptr; config: unit ptr; cache_file: string option; auto_sync: bool; mutable context_free: bool }}
 
+  let free t =
+    if not t.context_free then
+      let () = ignore (Bindings.futhark_context_sync t.handle) in
+      let () = ignore (Bindings.futhark_context_free t.handle) in
+      let () = ignore (Bindings.futhark_context_config_free t.config) in
+      t.context_free <- true
 
   let v ?(debug = false) ?(log = false) ?(profile = false) ?cache_file ?(auto_sync = true) {extra_param} () =
     let config = Bindings.futhark_context_config_new () in
@@ -18,18 +19,24 @@ module Context = struct
     {extra_line}
     Option.iter (Bindings.futhark_context_config_set_cache_file config) cache_file;
     let handle = Bindings.futhark_context_new config in
-    if is_null handle then (ignore @@ Bindings.futhark_context_config_free config; raise (Error NullPtr));
-    let t = {{ handle; config; cache_file; auto_sync }} in
-    Gc.finalise free t; t
+    if is_null handle then 
+      let () = ignore @@ Bindings.futhark_context_config_free config in
+      raise (Error NullPtr)
+    else
+      let t = {{ handle; config; cache_file; auto_sync; context_free = false }} in
+      let () = Gc.finalise free t in
+      t
 
   let sync t =
+    check_use_after_free `context t.context_free;
     let rc = Bindings.futhark_context_sync t.handle in
     if rc <> 0 then raise (Error (Code rc))
 
   let auto_sync t =
     if t.auto_sync then sync t
 
   let clear_caches t =
+    check_use_after_free `context t.context_free;
     let rc = Bindings.futhark_context_clear_caches t.handle in
     if rc <> 0 then raise (Error (Code rc))
 
@@ -40,13 +47,22 @@ module Context = struct
       let s = String.init len (fun i -> !@(ptr +@ i)) in
       let () = Bindings.free (coerce (Ctypes.ptr Ctypes.char) (Ctypes.ptr void) ptr) in Some s
 
-  let get_error t = let ptr = Bindings.futhark_context_get_error t.handle in string_opt_of_ptr ptr
+  let get_error t = 
+    check_use_after_free `context t.context_free;
+    let ptr = Bindings.futhark_context_get_error t.handle in string_opt_of_ptr ptr
+
+  let report t = 
+    check_use_after_free `context t.context_free;
+    let ptr = Bindings.futhark_context_report t.handle in string_opt_of_ptr ptr
 
-  let report t = let ptr = Bindings.futhark_context_report t.handle in string_opt_of_ptr ptr
+  let pause_profiling t = 
+    check_use_after_free `context t.context_free;
+    Bindings.futhark_context_pause_profiling t.handle
 
-  let pause_profiling t = Bindings.futhark_context_pause_profiling t.handle
-  let unpause_profiling t = Bindings.futhark_context_unpause_profiling t.handle
+  let unpause_profiling t =
+    check_use_after_free `context t.context_free;
+    Bindings.futhark_context_unpause_profiling t.handle
 end
 
-type futhark_array = {{ ptr: unit ptr; shape: int array; ctx: Context.t }}
-type opaque = {{ opaque_ptr: unit ptr; opaque_ctx: Context.t }}
+type futhark_array = {{ ptr: unit ptr; shape: int array; ctx: Context.t; mutable array_free: bool }}
+type opaque = {{ opaque_ptr: unit ptr; opaque_ctx: Context.t; mutable opaque_free: bool }}

src/generate/templates/ocaml/entry.ml

@@ -1,4 +1,5 @@
 let {name} ctx {entry_params} =
+  check_use_after_free `context ctx.Context.context_free;
 {out_decl}
   let rc = Bindings.futhark_entry_{name} ctx.Context.handle {call_args} in
   if rc <> 0 then raise (Error (Code rc));

src/generate/templates/ocaml/opaque.ml

@@ -3,11 +3,13 @@
   let _ = t
 
   let free t = 
-    ignore (Bindings.{free_fn} t.opaque_ctx.Context.handle t.opaque_ptr)
+    if not t.opaque_free && not t.opaque_ctx.Context.context_free then
+      let () = ignore (Bindings.{free_fn} t.opaque_ctx.Context.handle t.opaque_ptr) in
+      t.opaque_free <- true
 
   let of_ptr ctx ptr =
     if is_null ptr then raise (Error NullPtr);
-    let t = {{ opaque_ptr = ptr; opaque_ctx = ctx }} in
+    let t = {{ opaque_ptr = ptr; opaque_ctx = ctx; opaque_free = false }} in
     Gc.finalise free t; t
 
   let _ = of_ptr

src/generate/templates/ocaml/record.ml

@@ -1,8 +1,9 @@
   let v ctx {new_params} =
+    check_use_after_free `context ctx.Context.context_free;
     let ptr = allocate (ptr void) null in
     let rc = Bindings.{new_fn} ctx.Context.handle ptr {new_call_args} in
     Context.auto_sync ctx;
     if rc <> 0 then raise (Error (Code rc));
     let opaque_ptr = !@ptr in
-    let t = {{ opaque_ptr; opaque_ctx = ctx }} in
+    let t = {{ opaque_ptr; opaque_ctx = ctx; opaque_free = false }} in
     Gc.finalise free t; t

src/generate/templates/ocaml/record_project.ml

@@ -1,4 +1,6 @@
   let get_{name} t =
+    check_use_after_free `context t.opaque_ctx.Context.context_free;
+    check_use_after_free `opaque t.opaque_free;
     let out = allocate_n ~count:1 {s} in
     let rc = Bindings.{project} t.opaque_ctx.Context.handle out t.opaque_ptr in
     if rc <> 0 then raise (Error (Code rc));