[sqlite] more info on error

Summary: Get the error message from the database when there's an error, together with the error type.

Reviewed By: mbouaziz

Differential Revision: D6621695

fbshipit-source-id: 6bc706d

infer/src/IR/Attributes.ml

@@ -56,16 +56,16 @@ FROM (
 
 
 let replace pname_blob akind loc_file attr_blob =
-  ResultsDatabase.with_registered_statement replace_statement ~f:(fun replace_stmt ->
+  ResultsDatabase.with_registered_statement replace_statement ~f:(fun db replace_stmt ->
       Sqlite3.bind replace_stmt 1 (* :pname *) pname_blob
-      |> SqliteUtils.check_sqlite_error ~log:"replace bind pname" ;
+      |> SqliteUtils.check_sqlite_error db ~log:"replace bind pname" ;
       Sqlite3.bind replace_stmt 2 (* :akind *) (Sqlite3.Data.INT (int64_of_attributes_kind akind))
-      |> SqliteUtils.check_sqlite_error ~log:"replace bind attribute kind" ;
+      |> SqliteUtils.check_sqlite_error db ~log:"replace bind attribute kind" ;
       Sqlite3.bind replace_stmt 3 (* :sfile *) loc_file
-      |> SqliteUtils.check_sqlite_error ~log:"replace bind source file" ;
+      |> SqliteUtils.check_sqlite_error db ~log:"replace bind source file" ;
       Sqlite3.bind replace_stmt 4 (* :pattr *) attr_blob
-      |> SqliteUtils.check_sqlite_error ~log:"replace bind proc attributes" ;
-      SqliteUtils.sqlite_unit_step ~finalize:false ~log:"Attributes.replace" replace_stmt )
+      |> SqliteUtils.check_sqlite_error db ~log:"replace bind proc attributes" ;
+      SqliteUtils.sqlite_unit_step db ~finalize:false ~log:"Attributes.replace" replace_stmt )
 
 
 let find_more_defined_statement =
@@ -79,12 +79,12 @@ WHERE proc_name = :pname
 
 
 let should_try_to_update pname_blob akind =
-  ResultsDatabase.with_registered_statement find_more_defined_statement ~f:(fun find_stmt ->
+  ResultsDatabase.with_registered_statement find_more_defined_statement ~f:(fun db find_stmt ->
       Sqlite3.bind find_stmt 1 (* :pname *) pname_blob
-      |> SqliteUtils.check_sqlite_error ~log:"replace bind pname" ;
+      |> SqliteUtils.check_sqlite_error db ~log:"replace bind pname" ;
       Sqlite3.bind find_stmt 2 (* :akind *) (Sqlite3.Data.INT (int64_of_attributes_kind akind))
-      |> SqliteUtils.check_sqlite_error ~log:"replace bind attribute kind" ;
-      SqliteUtils.sqlite_result_step ~finalize:false ~log:"Attributes.replace" find_stmt
+      |> SqliteUtils.check_sqlite_error db ~log:"replace bind attribute kind" ;
+      SqliteUtils.sqlite_result_step ~finalize:false ~log:"Attributes.replace" db find_stmt
       |> (* there is no entry with a strictly larger "definedness" for that proc name *)
          Option.is_none )
 
@@ -101,10 +101,10 @@ let select_defined_statement =
 
 let find ~defined pname_blob =
   (if defined then select_defined_statement else select_statement)
-  |> ResultsDatabase.with_registered_statement ~f:(fun select_stmt ->
+  |> ResultsDatabase.with_registered_statement ~f:(fun db select_stmt ->
          Sqlite3.bind select_stmt 1 pname_blob
-         |> SqliteUtils.check_sqlite_error ~log:"find bind proc name" ;
-         SqliteUtils.sqlite_result_step ~finalize:false ~log:"Attributes.find" select_stmt
+         |> SqliteUtils.check_sqlite_error db ~log:"find bind proc name" ;
+         SqliteUtils.sqlite_result_step ~finalize:false ~log:"Attributes.find" db select_stmt
          |> Option.map ~f:ProcAttributes.SQLite.deserialize )
 
 

infer/src/IR/Cfg.ml

@@ -100,10 +100,10 @@ module SQLite = SqliteUtils.MarshalledData (struct
 end)
 
 let load source =
-  ResultsDatabase.with_registered_statement load_statement ~f:(fun load_stmt ->
+  ResultsDatabase.with_registered_statement load_statement ~f:(fun db load_stmt ->
       SourceFile.SQLite.serialize source |> Sqlite3.bind load_stmt 1
-      |> SqliteUtils.check_sqlite_error ~log:"load bind source file" ;
-      SqliteUtils.sqlite_result_step ~finalize:false ~log:"Cfg.load" load_stmt
+      |> SqliteUtils.check_sqlite_error db ~log:"load bind source file" ;
+      SqliteUtils.sqlite_result_step ~finalize:false ~log:"Cfg.load" db load_stmt
       |> Option.map ~f:SQLite.deserialize )
 
 
@@ -288,14 +288,14 @@ let store source_file cfg =
      OndemandCapture module relies on it - it uses existance of the cfg as a barrier to make
      sure that all attributes were written to disk (but not necessarily flushed) *)
   save_attributes source_file cfg ;
-  ResultsDatabase.with_registered_statement store_statement ~f:(fun store_stmt ->
+  ResultsDatabase.with_registered_statement store_statement ~f:(fun db store_stmt ->
       SourceFile.SQLite.serialize source_file |> Sqlite3.bind store_stmt 1
       (* :source *)
-      |> SqliteUtils.check_sqlite_error ~log:"store bind source file" ;
+      |> SqliteUtils.check_sqlite_error db ~log:"store bind source file" ;
       SQLite.serialize cfg |> Sqlite3.bind store_stmt 2
       (* :cfg *)
-      |> SqliteUtils.check_sqlite_error ~log:"store bind cfg" ;
-      SqliteUtils.sqlite_unit_step ~finalize:false ~log:"Cfg.store" store_stmt )
+      |> SqliteUtils.check_sqlite_error db ~log:"store bind cfg" ;
+      SqliteUtils.sqlite_unit_step ~finalize:false ~log:"Cfg.store" db store_stmt )
 
 
 (** Applies convert_instr_list to all the instructions in all the nodes of the cfg *)

infer/src/base/MergeResults.ml

@@ -10,11 +10,12 @@ open! IStd
 module L = Logging
 
 let merge_attributes_table ~db_file =
+  let db = ResultsDatabase.get_database () in
   (* Do the merge purely in SQL for great speed. The query works by doing a left join between the
      sub-table and the main one, and applying the same "more defined" logic as in Attributes in the
      cases where a proc_name is present in both the sub-table and the main one (main.attr_kind !=
      NULL). All the rows that pass this filter are inserted/updated into the main table. *)
-  Sqlite3.exec (ResultsDatabase.get_database ())
+  Sqlite3.exec db
     {|
 INSERT OR REPLACE INTO attributes
 SELECT sub.proc_name, sub.attr_kind, sub.source_file, sub.proc_attributes
@@ -27,26 +28,26 @@ WHERE
   OR main.attr_kind < sub.attr_kind
   OR (main.attr_kind = sub.attr_kind AND main.source_file < sub.source_file)
 |}
-  |> SqliteUtils.check_sqlite_error
+  |> SqliteUtils.check_sqlite_error db
        ~log:(Printf.sprintf "copying attributes of database '%s'" db_file)
 
 
 let merge_cfg_table ~db_file =
-  Sqlite3.exec (ResultsDatabase.get_database ())
-    "INSERT OR REPLACE INTO cfg SELECT * FROM attached.cfg"
-  |> SqliteUtils.check_sqlite_error ~log:(Printf.sprintf "copying cfg of database '%s'" db_file)
+  let db = ResultsDatabase.get_database () in
+  Sqlite3.exec db "INSERT OR REPLACE INTO cfg SELECT * FROM attached.cfg"
+  |> SqliteUtils.check_sqlite_error db ~log:(Printf.sprintf "copying cfg of database '%s'" db_file)
 
 
 let merge ~db_file =
   let main_db = ResultsDatabase.get_database () in
-  SqliteUtils.check_sqlite_error ~fatal:true
-    ~log:(Printf.sprintf "attaching database '%s'" db_file)
-    (Sqlite3.exec main_db (Printf.sprintf "ATTACH '%s' AS attached" db_file)) ;
+  Sqlite3.exec main_db (Printf.sprintf "ATTACH '%s' AS attached" db_file)
+  |> SqliteUtils.check_sqlite_error ~fatal:true main_db
+       ~log:(Printf.sprintf "attaching database '%s'" db_file) ;
   merge_attributes_table ~db_file ;
   merge_cfg_table ~db_file ;
-  SqliteUtils.check_sqlite_error ~fatal:true
-    ~log:(Printf.sprintf "detaching database '%s'" db_file)
-    (Sqlite3.exec main_db "DETACH attached") ;
+  Sqlite3.exec main_db "DETACH attached"
+  |> SqliteUtils.check_sqlite_error ~fatal:true main_db
+       ~log:(Printf.sprintf "detaching database '%s'" db_file) ;
   ()
 
 

infer/src/base/ResultsDatabase.ml

@@ -81,7 +81,7 @@ let db_canonicalize () =
   SqliteUtils.exec db ~log:"running VACUUM" ~stmt:"VACUUM"
 
 
-type registered_stmt = unit -> Sqlite3.stmt
+type registered_stmt = unit -> Sqlite3.stmt * Sqlite3.db
 
 let register_statement =
   let k stmt0 =
@@ -92,26 +92,26 @@ let register_statement =
           L.die InternalError "Could not prepare the following statement:@\n%s@\nReason: %s" stmt0
             error
       in
-      on_close_database ~f:(fun _ -> SqliteUtils.finalize ~log:"db close callback" stmt) ;
-      stmt_ref := Some stmt
+      on_close_database ~f:(fun _ -> SqliteUtils.finalize db ~log:"db close callback" stmt) ;
+      stmt_ref := Some (stmt, db)
     in
     on_new_database_connection ~f:new_statement ;
     fun () ->
       match !stmt_ref with
       | None ->
           L.(die InternalError) "database not initialized"
-      | Some stmt ->
+      | Some (stmt, db) ->
           Sqlite3.clear_bindings stmt
-          |> SqliteUtils.check_sqlite_error ~log:"clear bindings of prepared statement" ;
-          stmt
+          |> SqliteUtils.check_sqlite_error db ~log:"clear bindings of prepared statement" ;
+          (stmt, db)
   in
   fun stmt_fmt -> Printf.ksprintf k stmt_fmt
 
 
 let with_registered_statement get_stmt ~f =
-  let stmt = get_stmt () in
-  let result = f stmt in
-  Sqlite3.reset stmt |> SqliteUtils.check_sqlite_error ~log:"reset prepared statement" ;
+  let stmt, db = get_stmt () in
+  let result = f db stmt in
+  Sqlite3.reset stmt |> SqliteUtils.check_sqlite_error db ~log:"reset prepared statement" ;
   result
 
 

infer/src/base/ResultsDatabase.mli

@@ -42,4 +42,4 @@ val register_statement : ('a, unit, string, registered_stmt) Base.format4 -> 'a
     statement, or about generating new statements when the connection to the DB changes: this is all
     handled internally. *)
 
-val with_registered_statement : registered_stmt -> f:(Sqlite3.stmt -> 'a) -> 'a
+val with_registered_statement : registered_stmt -> f:(Sqlite3.db -> Sqlite3.stmt -> 'a) -> 'a

infer/src/base/SqliteUtils.ml

@@ -15,29 +15,29 @@ let error ~fatal fmt =
   (if fatal then Format.kasprintf (fun err -> raise (Error err)) else L.internal_error) fmt
 
 
-let check_sqlite_error ?(fatal= false) ~log rc =
+let check_sqlite_error ?(fatal= false) db ~log rc =
   match (rc : Sqlite3.Rc.t) with
   | OK | ROW ->
       ()
   | _ as err ->
-      error ~fatal "%s: %s" log (Sqlite3.Rc.to_string err)
+      error ~fatal "%s: %s (%s)" log (Sqlite3.Rc.to_string err) (Sqlite3.errmsg db)
 
 
 let exec db ~log ~stmt =
   (* Call [check_sqlite_error] with [fatal:true] and catch exceptions to rewrite the error message. This avoids allocating the error string when not needed. *)
-  try check_sqlite_error ~fatal:true ~log (Sqlite3.exec db stmt) with Error err ->
-    error ~fatal:true "exec: %s" err
+  try check_sqlite_error ~fatal:true db ~log (Sqlite3.exec db stmt) with Error err ->
+    error ~fatal:true "exec: %s (%s)" err (Sqlite3.errmsg db)
 
 
-let finalize ~log stmt =
-  try check_sqlite_error ~fatal:true ~log (Sqlite3.finalize stmt) with
+let finalize db ~log stmt =
+  try check_sqlite_error ~fatal:true db ~log (Sqlite3.finalize stmt) with
   | Error err ->
-      error ~fatal:true "finalize: %s" err
+      error ~fatal:true "finalize: %s (%s)" err (Sqlite3.errmsg db)
   | Sqlite3.Error err ->
-      error ~fatal:true "finalize: %s: %s" log err
+      error ~fatal:true "finalize: %s: %s (%s)" log err (Sqlite3.errmsg db)
 
 
-let sqlite_result_rev_list_step ?finalize:(do_finalize = true) ~log stmt =
+let sqlite_result_rev_list_step ?finalize:(do_finalize = true) db ~log stmt =
   let rec aux rev_results =
     match Sqlite3.step stmt with
     | Sqlite3.Rc.ROW ->
@@ -47,14 +47,14 @@ let sqlite_result_rev_list_step ?finalize:(do_finalize = true) ~log stmt =
     | DONE ->
         rev_results
     | err ->
-        L.die InternalError "%s: %s" log (Sqlite3.Rc.to_string err)
+        L.die InternalError "%s: %s (%s)" log (Sqlite3.Rc.to_string err) (Sqlite3.errmsg db)
   in
-  if do_finalize then protect ~finally:(fun () -> finalize ~log stmt) ~f:(fun () -> aux [])
+  if do_finalize then protect ~finally:(fun () -> finalize db ~log stmt) ~f:(fun () -> aux [])
   else aux []
 
 
-let sqlite_result_step ?finalize ~log stmt =
-  match sqlite_result_rev_list_step ?finalize ~log stmt with
+let sqlite_result_step ?finalize db ~log stmt =
+  match sqlite_result_rev_list_step ?finalize db ~log stmt with
   | [] ->
       None
   | [x] ->
@@ -63,8 +63,8 @@ let sqlite_result_step ?finalize ~log stmt =
       L.die InternalError "%s: zero or one result expected, got %d instead" log (List.length l)
 
 
-let sqlite_unit_step ?finalize ~log stmt =
-  match sqlite_result_rev_list_step ?finalize ~log stmt with
+let sqlite_unit_step ?finalize db ~log stmt =
+  match sqlite_result_rev_list_step ?finalize db ~log stmt with
   | [] ->
       ()
   | l ->

infer/src/base/SqliteUtils.mli

@@ -12,23 +12,24 @@ open! IStd
 exception Error of string
     (** The functions in this module tend to raise more often than their counterparts in [Sqlite3]. In particular, they may raise if the [Sqlite3.Rc.t] result of certain operations is unexpected. *)
 
-val check_sqlite_error : ?fatal:bool -> log:string -> Sqlite3.Rc.t -> unit
+val check_sqlite_error : ?fatal:bool -> Sqlite3.db -> log:string -> Sqlite3.Rc.t -> unit
 (** Assert that the result is either [Sqlite3.Rc.OK]. If [row_is_ok] then [Sqlite3.Rc.ROW] is also accepted. If the result is not valid, then if [fatal] is set raise [Error], otherwise log the error and proceed. *)
 
 val exec : Sqlite3.db -> log:string -> stmt:string -> unit
 (** Execute the given Sqlite [stmt] and asserts that it resulted in [Sqlite3.Rc.OK]. Otherwise, fail similarly to [check_sqlite_error ~fatal:true]. *)
 
-val finalize : log:string -> Sqlite3.stmt -> unit
+val finalize : Sqlite3.db -> log:string -> Sqlite3.stmt -> unit
 (** Finalize the given [stmt]. Raises [Error] on failure. *)
 
 val sqlite_result_rev_list_step :
-  ?finalize:bool -> log:string -> Sqlite3.stmt -> Sqlite3.Data.t option list
+  ?finalize:bool -> Sqlite3.db -> log:string -> Sqlite3.stmt -> Sqlite3.Data.t option list
 (** Return a reversed list of results obtained by repeatedly stepping through [stmt] and saving only column 0 of each returned row (all that's been needed so far). *)
 
-val sqlite_result_step : ?finalize:bool -> log:string -> Sqlite3.stmt -> Sqlite3.Data.t option
+val sqlite_result_step :
+  ?finalize:bool -> Sqlite3.db -> log:string -> Sqlite3.stmt -> Sqlite3.Data.t option
 (** Same as [sqlite_result_rev_list_step] but asserts that at most one result is returned. *)
 
-val sqlite_unit_step : ?finalize:bool -> log:string -> Sqlite3.stmt -> unit
+val sqlite_unit_step : ?finalize:bool -> Sqlite3.db -> log:string -> Sqlite3.stmt -> unit
 (** Same as [sqlite_result_rev_list_step] but asserts that no result is returned. *)
 
 val db_close : Sqlite3.db -> unit