Merge remote-tracking branch 'origin/pr/55' into pr/55

Author: mmottl

lib/postgresql.ml

@@ -338,7 +338,6 @@ module Stub = struct
   type connection
   type result
 
-  external conn_isnull : connection -> bool = "PQconn_isnull" [@@noalloc]
   external connect : string -> bool -> connection = "PQconnectdb_stub"
   external finish : connection -> unit = "PQfinish_stub"
   external reset : connection -> unit = "PQreset_stub"
@@ -955,9 +954,11 @@ module Connection (Mutex : Mutex) = struct
          else Gc.finalise Stub.finish my_conn
        in
        let conn_mtx = Mutex.create () in
-       let finishing = ref false in
+       let cancel_mtx = Mutex.create () in
+       let finished = ref false in
+       (* bool becomes true after deallocation *)
        let check_null () =
-         if !finishing || Stub.conn_isnull my_conn then
+         if !finished then
            failwith "Postgresql.check_null: connection already finished"
        in
        let wrap_conn f =
@@ -969,11 +970,32 @@ module Connection (Mutex : Mutex) = struct
              (* Check again in case the world has changed *)
              f my_conn)
        in
+       let wrap_cancel f =
+         protectx
+           ~f:(fun _ ->
+             Mutex.lock cancel_mtx;
+             check_null ();
+             (* Check again in case the world has changed *)
+             f my_conn)
+           ~finally:(fun _ -> Mutex.unlock cancel_mtx)
+       in
+       let wrap_both f =
+         protectx
+           ~f:(fun _ ->
+             Mutex.lock conn_mtx;
+             Mutex.lock cancel_mtx;
+             check_null ();
+             (* Check again in case the world has changed *)
+             f my_conn)
+           ~finally:(fun _ ->
+             Mutex.unlock cancel_mtx;
+             Mutex.unlock conn_mtx)
+       in
        let signal_error conn =
          raise (Error (Connection_failure (Stub.error_message conn)))
        in
        let request_cancel () =
-         wrap_conn (fun _ ->
+         wrap_cancel (fun _ ->
              match Stub.request_cancel my_conn with
              | None -> ()
              | Some err -> raise (Error (Cancel_failure err)))
@@ -999,9 +1021,9 @@ module Connection (Mutex : Mutex) = struct
 
        object (self (* Main routines *))
          method finish =
-           wrap_conn (fun c ->
+           wrap_both (fun c ->
                Stub.finish c;
-               finishing := true)
+               finished := true)
 
          method try_reset =
            wrap_conn (fun conn ->

lib/postgresql_stubs.c

@@ -266,10 +266,6 @@ static inline void np_decr_refcount(np_callback *c) {
 #define get_cancel_obj(v) ((PGcancel *)Field(v, 2))
 #define set_cancel_obj(v, cancel) (Field(v, 2) = (value)cancel)
 
-CAMLprim value PQconn_isnull(value v_conn) {
-  return Val_bool((get_conn(v_conn)) ? 0 : 1);
-}
-
 static inline void free_conn(value v_conn) {
   PGconn *conn = get_conn(v_conn);
   if (conn) {