broken.ml

module Sqlexpr = Sqlexpr_sqlite.Make(Sqlexpr_concurrency.Lwt)
module S = Sqlexpr
open Lwt.Infix
let test_retry_begin =
  let __ppx_sqlexpr_shared_1 =
    { 
      Sqlexpr.statement =
        { 
          Sqlexpr.sql_statement = "SELECT COUNT(*) FROM foo";
          stmt_id = (Some "9e11a7554f37de62d53f51cdd7f94b6b");
          directive =
            (fun __ppx_sql_3  ->
               fun __ppx_sql_4  ->
                 let open Sqlexpr.Directives in __ppx_sql_3 __ppx_sql_4)
        };
      get_data =
        (1, (fun __ppx_sql_5  -> Sqlexpr.Conversion.int (__ppx_sql_5.(0))))
    } in
  let __ppx_sqlexpr_shared_0 =
    { 
      Sqlexpr.sql_statement = "INSERT INTO foo VALUES(?)";
      stmt_id = (Some "faa377c8fce1ed4accfdb8ccab38d2bc");
      directive =
        (fun __ppx_sql_1  ->
           fun __ppx_sql_2  ->
             let open Sqlexpr.Directives in (int __ppx_sql_1) __ppx_sql_2)
    } in
  fun ()  ->
    let count_rows db = S.select_one db __ppx_sqlexpr_shared_1 in
    let insert v db =
      let __ppx_lwt_0 =
        { 
          Sqlexpr.sql_statement = "INSERT INTO foo VALUES(?)";
          stmt_id = (Some "faa377c8fce1ed4accfdb8ccab38d2bc");
          directive =
            (fun __ppx_sql_1  ->
               fun __ppx_sql_2  ->
                 let open Sqlexpr.Directives in (int __ppx_sql_1) __ppx_sql_2)
        } in
      Lwt.bind __ppx_lwt_0
        (fun __ppx_sqlexpr_shared_0  ->
                  let _ = count_rows db in
           (Lwt_unix.sleep 0.010) >>=
             (fun ()  -> S.insert db __ppx_sqlexpr_shared_0 v)) in
    Lwt.return ()

expected.ml

module Sqlexpr = Sqlexpr_sqlite.Make(Sqlexpr_concurrency.Lwt)
module S = Sqlexpr
open Lwt.Infix
let test_retry_begin =
  let __ppx_sqlexpr_shared_1 =
    {
      Sqlexpr.statement =
        {
          Sqlexpr.sql_statement = "SELECT COUNT(*) FROM foo";
          stmt_id = (Some "bb78716a331f1ef9bb1e31cc0ec55f1f");
          directive =
            (fun __ppx_sql_3  ->
               fun __ppx_sql_4  ->
                 let open Sqlexpr.Directives in __ppx_sql_3 __ppx_sql_4)
        };
      get_data =
        (1, (fun __ppx_sql_5  -> Sqlexpr.Conversion.int (__ppx_sql_5.(0))))
    } in
  let __ppx_sqlexpr_shared_0 =
    {
      Sqlexpr.sql_statement = "INSERT INTO foo VALUES(?)";
      stmt_id = (Some "646a63ee9b0850c552c060b3e473ac2e");
      directive =
        (fun __ppx_sql_1  ->
           fun __ppx_sql_2  ->
             let open Sqlexpr.Directives in (int __ppx_sql_1) __ppx_sql_2)
    } in
  fun ()  ->
    let count_rows db = S.select_one db __ppx_sqlexpr_shared_1 in
    let insert v db =
      let __ppx_lwt_0 = count_rows db in
      Lwt.bind __ppx_lwt_0
        (fun _  ->
           (Lwt_unix.sleep 0.010) >>=
             (fun ()  -> S.insert db __ppx_sqlexpr_shared_0 v)) in
    Lwt.return ()

original.ml

module Sqlexpr = Sqlexpr_sqlite.Make(Sqlexpr_concurrency.Lwt)
module S = Sqlexpr

open Lwt.Infix

let test_retry_begin () =

  let count_rows db =
    S.select_one db [%sqlc "SELECT @d{COUNT(*)} FROM foo"] in

  let insert v db =
    (* SELECT acquires a SHARED lock if needed *)
    let%lwt _ = count_rows db in
    Lwt_unix.sleep 0.010 >>= fun () ->
      (* RESERVED lock acquired if needed *)
      S.insert db [%sqlc "INSERT INTO foo VALUES(%d)"] v in
      Lwt.return ()