Improved handling of user function exceptions

Author: mmottl

CHANGES.txt

@@ -1,3 +1,13 @@
+2015-09-02: Major API change that is compatible with major release series 2:
+
+            It is now possible to return errors from user-defined SQL-functions
+            by simply raising (arbitrary) exceptions.  This somewhat
+            tricky internal change eliminates the need for Data.ERROR and
+            reestablishes compatibility with major release series 2.
+
+            Sorry for the churn, but the more elegant solution was not
+            quite obvious!
+
 2015-08-29: Added user function error handling (major API change).
 
             Thanks to Joseph Young for this patch!

_oasis

@@ -1,6 +1,6 @@
 OASISFormat:      0.4
 Name:             sqlite3
-Version:          3.0.0
+Version:          4.0.0
 Synopsis:         sqlite3-ocaml - SQLite3 bindings
 Description:      sqlite3-ocaml is an OCaml library with bindings to the
                   SQLite3 client API.  Sqlite3 is a self-contained, serverless,
@@ -41,7 +41,7 @@ Library sqlite3
   CCOpt:          -g -O2 -fPIC -DPIC
   if flag(strict) && ccomp_type(cc)
     CCOpt+:       -Wall -pedantic -Wextra -Wunused -Wno-long-long
-  CCLib:          -lsqlite3
+  CCLib:          -lsqlite3 -lpthread
 
 
 # Tests

lib/META

@@ -1,6 +1,6 @@
 # OASIS_START
-# DO NOT EDIT (digest: fc7db74acb0529e253896e714e0a428b)
-version = "3.0.0"
+# DO NOT EDIT (digest: 5c96ba55072fdd9b0770a2d5872a8c6d)
+version = "4.0.0"
 description = "sqlite3-ocaml - SQLite3 bindings"
 archive(byte) = "sqlite3.cma"
 archive(byte, plugin) = "sqlite3.cma"

lib/sqlite3.ml

@@ -112,13 +112,12 @@ module Data = struct
     | FLOAT of float
     | TEXT of string
     | BLOB of string
-    | ERROR of string
 
   let to_string = function
     | NONE | NULL -> ""
     | INT i -> Int64.to_string i
     | FLOAT f -> string_of_float f
-    | TEXT t | BLOB t | ERROR t -> t
+    | TEXT t | BLOB t -> t
 
   let to_string_debug = function
     | NONE -> "NONE"
@@ -127,7 +126,6 @@ module Data = struct
     | FLOAT f -> sprintf "FLOAT <%f>" f
     | TEXT t -> sprintf "TEXT <%S>" t
     | BLOB b -> sprintf "BLOB <%d>" (String.length b)
-    | ERROR e -> sprintf "ERROR <%S>" e
 end
 
 type header = string

lib/sqlite3.mli

@@ -142,7 +142,6 @@ module Data : sig
     | FLOAT of float
     | TEXT of string
     | BLOB of string
-    | ERROR of string
 
   val to_string : t -> string
   (** [to_string data] converts [data] to a string.  Both [NONE] and

lib/sqlite3_stubs.c

@@ -37,6 +37,7 @@
 #include <caml/signals.h>
 
 #include <sqlite3.h>
+#include <pthread.h>
 
 #if __GNUC__ >= 3
 # define inline inline __attribute__ ((always_inline))
@@ -105,6 +106,46 @@ typedef struct stmt_wrap {
 } stmt_wrap;
 
 
+/* Handling of exceptions in user-defined SQL-functions */
+
+/* For propagating exceptions from user-defined SQL-functions */
+static pthread_key_t user_exception_key;
+
+typedef struct user_exception { value exn; } user_exception;
+
+static inline void create_user_exception(value exn)
+{
+  user_exception *user_exn = malloc(sizeof(user_exception));
+  user_exn->exn = exn;
+  caml_register_global_root(&user_exn->exn);
+  pthread_setspecific(user_exception_key, user_exn);
+}
+
+static inline void destroy_user_exception(void *user_exc_)
+{
+  user_exception *user_exn = user_exc_;
+  caml_remove_global_root(&user_exn->exn);
+  free(user_exn);
+}
+
+static inline void maybe_raise_user_exception(int rc)
+{
+  if (rc == SQLITE_ERROR) {
+    user_exception *user_exn = pthread_getspecific(user_exception_key);
+
+    if (user_exn != NULL) {
+      CAMLparam0();
+      CAMLlocal1(v_exn);
+      v_exn = user_exn->exn;
+      destroy_user_exception(user_exn);
+      pthread_setspecific(user_exception_key, NULL);
+      caml_raise(v_exn);
+      CAMLnoreturn;
+    }
+  }
+}
+
+
 /* Macros to access the wrapper structures stored in the custom blocks */
 
 #define Sqlite3_val(x) (*((db_wrap **) (Data_custom_val(x))))
@@ -120,11 +161,11 @@ static value *caml_sqlite3_RangeError = NULL;
 static inline void raise_with_two_args(value v_tag, value v_arg1, value v_arg2)
 {
   CAMLparam3(v_tag, v_arg1, v_arg2);
-  value v_exc = caml_alloc_small(3, 0);
-  Field(v_exc, 0) = v_tag;
-  Field(v_exc, 1) = v_arg1;
-  Field(v_exc, 2) = v_arg2;
-  caml_raise(v_exc);
+  value v_exn = caml_alloc_small(3, 0);
+  Field(v_exn, 0) = v_tag;
+  Field(v_exn, 1) = v_arg1;
+  Field(v_exn, 2) = v_arg2;
+  caml_raise(v_exn);
   CAMLnoreturn;
 }
 
@@ -215,6 +256,7 @@ CAMLprim value caml_sqlite3_init(value __unused v_unit)
   caml_sqlite3_InternalError = caml_named_value("Sqlite3.InternalError");
   caml_sqlite3_Error = caml_named_value("Sqlite3.Error");
   caml_sqlite3_RangeError = caml_named_value("Sqlite3.RangeError");
+  pthread_key_create(&user_exception_key, destroy_user_exception);
   return Val_unit;
 }
 
@@ -521,6 +563,7 @@ CAMLprim value caml_sqlite3_exec(value v_db, value v_maybe_cb, value v_sql)
   caml_leave_blocking_section();
 
   if (rc == SQLITE_ABORT) caml_raise(*cbx.exn);
+  maybe_raise_user_exception(rc);
 
   CAMLreturn(Val_rc(rc));
 }
@@ -570,6 +613,7 @@ CAMLprim value caml_sqlite3_exec_no_headers(value v_db, value v_cb, value v_sql)
   caml_leave_blocking_section();
 
   if (rc == SQLITE_ABORT) caml_raise(*cbx.exn);
+  maybe_raise_user_exception(rc);
 
   CAMLreturn(Val_rc(rc));
 }
@@ -633,6 +677,8 @@ CAMLprim value caml_sqlite3_exec_not_null(value v_db, value v_cb, value v_sql)
     if (*cbx.exn != 0) caml_raise(*cbx.exn);
     else raise_sqlite3_Error("Null element in row");
   }
+  maybe_raise_user_exception(rc);
+
   CAMLreturn(Val_rc(rc));
 }
 
@@ -692,6 +738,8 @@ CAMLprim value caml_sqlite3_exec_not_null_no_headers(
     if (*cbx.exn != 0) caml_raise(*cbx.exn);
     else raise_sqlite3_Error("Null element in row");
   }
+  maybe_raise_user_exception(rc);
+
   CAMLreturn(Val_rc(rc));
 }
 
@@ -847,7 +895,6 @@ CAMLprim value caml_sqlite3_bind(value v_stmt, value v_index, value v_data)
                                         String_val(v_field),
                                         caml_string_length(v_field),
                                         SQLITE_TRANSIENT));
-      case 4 : return Val_rc(SQLITE_ERROR);
     }
   }
   return Val_rc(SQLITE_ERROR);
@@ -1002,14 +1049,15 @@ static inline value caml_sqlite3_wrap_values(int argc, sqlite3_value **args)
   }
 }
 
-static inline void exception_result(sqlite3_context *ctx)
+static inline void exception_result(sqlite3_context *ctx, value v_exn)
 {
   sqlite3_result_error(ctx, "OCaml callback raised an exception", -1);
+  create_user_exception(v_exn);
 }
 
 static inline void set_sqlite3_result(sqlite3_context *ctx, value v_res)
 {
-  if (Is_exception_result(v_res)) exception_result(ctx);
+  if (Is_exception_result(v_res)) exception_result(ctx, v_res);
   else if (Is_long(v_res)) sqlite3_result_null(ctx);
   else {
     value v = Field(v_res, 0);
@@ -1024,9 +1072,6 @@ static inline void set_sqlite3_result(sqlite3_context *ctx, value v_res)
         sqlite3_result_blob(
           ctx, String_val(v), caml_string_length(v), SQLITE_TRANSIENT);
         break;
-      case 4 :
-        sqlite3_result_error(ctx, String_val(v), caml_string_length(v));
-        break;
       default :
         sqlite3_result_error(ctx, "unknown value returned by callback", -1);
     }
@@ -1064,7 +1109,7 @@ static inline void caml_sqlite3_user_function_step(
     }
     v_args = caml_sqlite3_wrap_values(argc, argv);
     v_res = caml_callback2_exn(Field(data->v_fun, 2), agg_ctx->v_acc, v_args);
-    if (Is_exception_result(v_res)) exception_result(ctx);
+    if (Is_exception_result(v_res)) exception_result(ctx, v_res);
     else agg_ctx->v_acc = v_res;
   caml_enter_blocking_section();
 }

myocamlbuild.ml

@@ -1,5 +1,5 @@
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 8856c7fbdf56cf3b352c8f24a59be7a0) *)
+(* DO NOT EDIT (digest: 1308fb3d48472c2edc4cc51c862b6705) *)
 module OASISGettext = struct
 (* # 22 "src/oasis/OASISGettext.ml" *)
 
@@ -651,9 +651,12 @@ let package_default =
                    ])
             ]);
           (["oasis_library_sqlite3_cclib"; "link"],
-            [(OASISExpr.EBool true, S [A "-cclib"; A "-lsqlite3"])]);
+            [
+               (OASISExpr.EBool true,
+                 S [A "-cclib"; A "-lsqlite3"; A "-cclib"; A "-lpthread"])
+            ]);
           (["oasis_library_sqlite3_cclib"; "ocamlmklib"; "c"],
-            [(OASISExpr.EBool true, S [A "-lsqlite3"])])
+            [(OASISExpr.EBool true, S [A "-lsqlite3"; A "-lpthread"])])
        ];
      includes = [("test", ["lib"])]
   }
@@ -663,7 +666,7 @@ let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
 
 let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
 
-# 667 "myocamlbuild.ml"
+# 670 "myocamlbuild.ml"
 (* OASIS_STOP *)
 
 let read_lines_from_cmd ~max_lines cmd =

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.3.0 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 51146b2c34f38bae10732375ae42aa0e) *)
+(* DO NOT EDIT (digest: 1b6fe2a99f7d4b7e0a8fcaf32a49dc1a) *)
 (*
    Regenerated by OASIS v0.4.5
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -6981,7 +6981,7 @@ let setup_t =
           alpha_features = [];
           beta_features = [];
           name = "sqlite3";
-          version = "3.0.0";
+          version = "4.0.0";
           license =
             OASISLicense.DEP5License
               (OASISLicense.DEP5Unit
@@ -7097,7 +7097,8 @@ let setup_t =
                                 "-Wno-long-long"
                              ])
                         ];
-                      bs_cclib = [(OASISExpr.EBool true, ["-lsqlite3"])];
+                      bs_cclib =
+                        [(OASISExpr.EBool true, ["-lsqlite3"; "-lpthread"])];
                       bs_dlllib = [(OASISExpr.EBool true, [])];
                       bs_dllpath = [(OASISExpr.EBool true, [])];
                       bs_byteopt = [(OASISExpr.EBool true, [])];
@@ -7511,14 +7512,14 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.5";
-     oasis_digest = Some "µ¢]]±\1486t\133\000&¿º M£";
+     oasis_digest = Some "Ý7ö\022\139Kuâeùû_¥Ó\019?";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
   };;
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 7523 "setup.ml"
+# 7524 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;

test/test_error.ml

@@ -3,18 +3,6 @@ open Sqlite3
 (* Tests our ability to return an error from a user defined function *)
 let () =
   let db = db_open "t" in
-  create_fun0 db "MYERROR" (fun () -> Data.ERROR "This function always errors");
+  create_fun0 db "MYERROR" (fun () -> failwith "This function always errors");
   let res = exec db "SELECT MYERROR();" in
-  match res with
-  | Rc.ERROR -> print_endline (errmsg db)
-  | x -> prerr_endline ("Should have thrown an error: " ^ Rc.to_string x)
-
-(* Insures that we can't bind an error to a query *)
-let () =
-  let db = db_open "t" in
-  let _ : Rc.t = exec db "CREATE TABLE foo (val text);" in
-  let s = Sqlite3.prepare db "INSERT INTO foo values (?);" in
-  let res = Sqlite3.bind s 1 (Sqlite3.Data.ERROR "Should be impossible") in
-  match res with
-  | Rc.ERROR -> print_endline ("Bind threw an error")
-  | x -> prerr_endline ("Should have thrown an error: " ^ Rc.to_string x)
+  prerr_endline ("Should have thrown an error: " ^ Rc.to_string res)