diff --git a/infer/src/IR/Attributes.ml b/infer/src/IR/Attributes.ml index 5a7ed5e55..8e6355880 100644 --- a/infer/src/IR/Attributes.ml +++ b/infer/src/IR/Attributes.ml @@ -67,17 +67,17 @@ FROM ( let replace pname pname_blob akind loc_file attr_blob = ResultsDatabase.with_registered_statement replace_statement ~f:(fun db replace_stmt -> Sqlite3.bind replace_stmt 1 (* :pname *) pname_blob - |> SqliteUtils.check_sqlite_error db ~log:"replace bind pname" ; + |> SqliteUtils.check_result_code db ~log:"replace bind pname" ; Sqlite3.bind replace_stmt 2 (* :proc_name_hum *) (Sqlite3.Data.TEXT (Typ.Procname.to_string pname)) - |> SqliteUtils.check_sqlite_error db ~log:"replace bind proc_name_hum" ; + |> SqliteUtils.check_result_code db ~log:"replace bind proc_name_hum" ; Sqlite3.bind replace_stmt 3 (* :akind *) (Sqlite3.Data.INT (int64_of_attributes_kind akind)) - |> SqliteUtils.check_sqlite_error db ~log:"replace bind attribute kind" ; + |> SqliteUtils.check_result_code db ~log:"replace bind attribute kind" ; Sqlite3.bind replace_stmt 4 (* :sfile *) loc_file - |> SqliteUtils.check_sqlite_error db ~log:"replace bind source file" ; + |> SqliteUtils.check_result_code db ~log:"replace bind source file" ; Sqlite3.bind replace_stmt 5 (* :pattr *) attr_blob - |> SqliteUtils.check_sqlite_error db ~log:"replace bind proc attributes" ; - SqliteUtils.sqlite_unit_step db ~finalize:false ~log:"Attributes.replace" replace_stmt ) + |> SqliteUtils.check_result_code db ~log:"replace bind proc attributes" ; + SqliteUtils.result_unit db ~finalize:false ~log:"Attributes.replace" replace_stmt ) let find_more_defined_statement = @@ -93,10 +93,11 @@ WHERE proc_name = :pname let should_try_to_update pname_blob akind = 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 db ~log:"replace bind pname" ; + |> SqliteUtils.check_result_code db ~log:"replace bind pname" ; Sqlite3.bind find_stmt 2 (* :akind *) (Sqlite3.Data.INT (int64_of_attributes_kind akind)) - |> SqliteUtils.check_sqlite_error db ~log:"replace bind attribute kind" ; - SqliteUtils.sqlite_result_step ~finalize:false ~log:"Attributes.replace" db find_stmt + |> SqliteUtils.check_result_code db ~log:"replace bind attribute kind" ; + SqliteUtils.result_single_column_option ~finalize:false ~log:"Attributes.replace" db + find_stmt |> (* there is no entry with a strictly larger "definedness" for that proc name *) Option.is_none ) @@ -115,8 +116,9 @@ let find ~defined pname_blob = (if defined then select_defined_statement else select_statement) |> ResultsDatabase.with_registered_statement ~f:(fun db select_stmt -> Sqlite3.bind select_stmt 1 pname_blob - |> SqliteUtils.check_sqlite_error db ~log:"find bind proc name" ; - SqliteUtils.sqlite_result_step ~finalize:false ~log:"Attributes.find" db select_stmt + |> SqliteUtils.check_result_code db ~log:"find bind proc name" ; + SqliteUtils.result_single_column_option ~finalize:false ~log:"Attributes.find" db + select_stmt |> Option.map ~f:ProcAttributes.SQLite.deserialize ) diff --git a/infer/src/IR/Cfg.ml b/infer/src/IR/Cfg.ml index 6792c6bf8..7db0de395 100644 --- a/infer/src/IR/Cfg.ml +++ b/infer/src/IR/Cfg.ml @@ -62,8 +62,8 @@ end) let load source = ResultsDatabase.with_registered_statement load_statement ~f:(fun db load_stmt -> SourceFile.SQLite.serialize source |> Sqlite3.bind load_stmt 1 - |> SqliteUtils.check_sqlite_error db ~log:"load bind source file" ; - SqliteUtils.sqlite_result_step ~finalize:false ~log:"Cfg.load" db load_stmt + |> SqliteUtils.check_result_code db ~log:"load bind source file" ; + SqliteUtils.result_single_column_option ~finalize:false ~log:"Cfg.load" db load_stmt |> Option.map ~f:SQLite.deserialize ) diff --git a/infer/src/IR/SourceFiles.ml b/infer/src/IR/SourceFiles.ml index c5ec6b662..29d06612f 100644 --- a/infer/src/IR/SourceFiles.ml +++ b/infer/src/IR/SourceFiles.ml @@ -25,19 +25,12 @@ let get_existing_data source_file = ResultsDatabase.with_registered_statement select_existing_statement ~f:(fun db stmt -> SourceFile.SQLite.serialize source_file |> Sqlite3.bind stmt 1 (* :source *) - |> SqliteUtils.check_sqlite_error db ~log:"get_existing_data bind source file" ; - match Sqlite3.step stmt with - | Sqlite3.Rc.ROW -> - (* the operation returned a result, get it *) + |> SqliteUtils.check_result_code db ~log:"get_existing_data bind source file" ; + SqliteUtils.result_option ~finalize:false db ~log:"looking for pre-existing cfgs" stmt + ~read_row:(fun stmt -> let cfgs = Sqlite3.column stmt 0 |> Cfg.SQLite.deserialize and tenv = Sqlite3.column stmt 1 |> Tenv.SQLite.deserialize in - (match Sqlite3.step stmt with DONE -> () | _ -> assert false) ; - Some (cfgs, tenv) - | DONE -> - None - | err -> - L.die InternalError "Looking for pre-existing cfgs: %s (%s)" (Sqlite3.Rc.to_string err) - (Sqlite3.errmsg db) ) + (cfgs, tenv) ) ) let add source_file cfg tenv = @@ -62,27 +55,30 @@ let add source_file cfg tenv = 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 db ~log:"store bind source file" ; + |> SqliteUtils.check_result_code db ~log:"store bind source file" ; Cfg.SQLite.serialize cfg |> Sqlite3.bind store_stmt 2 (* :cfg *) - |> SqliteUtils.check_sqlite_error db ~log:"store bind cfg" ; + |> SqliteUtils.check_result_code db ~log:"store bind cfg" ; Tenv.SQLite.serialize tenv |> Sqlite3.bind store_stmt 3 (* :tenv *) - |> SqliteUtils.check_sqlite_error db ~log:"store bind type environment" ; + |> SqliteUtils.check_result_code db ~log:"store bind type environment" ; Cfg.get_all_proc_names cfg |> Typ.Procname.SQLiteList.serialize |> Sqlite3.bind store_stmt 4 (* :proc_names *) - |> SqliteUtils.check_sqlite_error db ~log:"store bind proc names" ; + |> SqliteUtils.check_result_code db ~log:"store bind proc names" ; Sqlite3.bind store_stmt 5 (Sqlite3.Data.INT Int64.one) (* :freshly_captured *) - |> SqliteUtils.check_sqlite_error db ~log:"store freshness" ; - SqliteUtils.sqlite_unit_step ~finalize:false ~log:"Cfg.store" db store_stmt ) + |> SqliteUtils.check_result_code db ~log:"store freshness" ; + SqliteUtils.result_unit ~finalize:false ~log:"Cfg.store" db store_stmt ) let get_all () = let db = ResultsDatabase.get_database () in + (* we could also register this statement but it's typically used only once per run so just prepare + it inside the function *) Sqlite3.prepare db "SELECT source_file FROM source_files" - |> SqliteUtils.sqlite_result_rev_list_step db ~log:"getting all source files" - |> List.map ~f:SourceFile.SQLite.deserialize + |> IContainer.rev_map_to_list + ~fold:(SqliteUtils.result_fold_single_column_rows db ~log:"getting all source files") + ~f:SourceFile.SQLite.deserialize let load_proc_names_statement = @@ -93,9 +89,9 @@ let load_proc_names_statement = let proc_names_of_source source = ResultsDatabase.with_registered_statement load_proc_names_statement ~f:(fun db load_stmt -> SourceFile.SQLite.serialize source |> Sqlite3.bind load_stmt 1 - |> SqliteUtils.check_sqlite_error db ~log:"load bind source file" ; - SqliteUtils.sqlite_result_step ~finalize:false db ~log:"SourceFiles.proc_names_of_source" - load_stmt + |> SqliteUtils.check_result_code db ~log:"load bind source file" ; + SqliteUtils.result_single_column_option ~finalize:false db + ~log:"SourceFiles.proc_names_of_source" load_stmt |> Option.value_map ~default:[] ~f:Typ.Procname.SQLiteList.deserialize ) @@ -107,8 +103,9 @@ let is_captured source = ResultsDatabase.with_registered_statement exists_source_statement ~f:(fun db exists_stmt -> SourceFile.SQLite.serialize source |> Sqlite3.bind exists_stmt 1 (* :k *) - |> SqliteUtils.check_sqlite_error db ~log:"load captured source file" ; - SqliteUtils.sqlite_result_step ~finalize:false ~log:"SourceFiles.is_captured" db exists_stmt + |> SqliteUtils.check_result_code db ~log:"load captured source file" ; + SqliteUtils.result_single_column_option ~finalize:false ~log:"SourceFiles.is_captured" db + exists_stmt |> Option.is_some ) @@ -118,7 +115,7 @@ let is_non_empty_statement = let is_empty () = ResultsDatabase.with_registered_statement is_non_empty_statement ~f:(fun db stmt -> - SqliteUtils.sqlite_result_step ~finalize:false ~log:"SourceFiles.is_empty" db stmt + SqliteUtils.result_single_column_option ~finalize:false ~log:"SourceFiles.is_empty" db stmt |> Option.is_none ) @@ -135,9 +132,9 @@ let deserialize_freshly_captured = function[@warning "-8"] let is_freshly_captured source = ResultsDatabase.with_registered_statement is_freshly_captured_statement ~f:(fun db load_stmt -> SourceFile.SQLite.serialize source |> Sqlite3.bind load_stmt 1 - |> SqliteUtils.check_sqlite_error db ~log:"load bind source file" ; - SqliteUtils.sqlite_result_step ~finalize:false ~log:"SourceFiles.is_freshly_captured" db - load_stmt + |> SqliteUtils.check_result_code db ~log:"load bind source file" ; + SqliteUtils.result_single_column_option ~finalize:false + ~log:"SourceFiles.is_freshly_captured" db load_stmt |> Option.value_map ~default:false ~f:deserialize_freshly_captured ) @@ -147,7 +144,7 @@ let mark_all_stale_statement = let mark_all_stale () = ResultsDatabase.with_registered_statement mark_all_stale_statement ~f:(fun db stmt -> - SqliteUtils.sqlite_unit_step db ~finalize:false ~log:"mark_all_stale" stmt ) + SqliteUtils.result_unit db ~finalize:false ~log:"mark_all_stale" stmt ) let select_all_source_files_statement = @@ -156,38 +153,35 @@ let select_all_source_files_statement = let pp_all ?filter ~cfgs ~type_environment ~procedure_names ~freshly_captured fmt () = let filter = Staged.unstage (Filtering.mk_source_file_filter ~filter) in + let pp_procnames fmt procs = + F.fprintf fmt "@[" ; + List.iter ~f:(F.fprintf fmt "%a@," Typ.Procname.pp) procs ; + F.fprintf fmt "@]" + in + let pp_if stmt title condition deserialize pp fmt column = + if condition then + F.fprintf fmt " @[%s@,%a@]@;" title pp (Sqlite3.column stmt column |> deserialize) + in + let pp_row stmt fmt source_file = + F.fprintf fmt "%a@,%a%a%a%a" SourceFile.pp source_file + (pp_if stmt "cfgs" cfgs Cfg.SQLite.deserialize Cfg.pp_proc_signatures) + 1 + (pp_if stmt "type_environment" type_environment Tenv.SQLite.deserialize Tenv.pp_per_file) + 2 + (pp_if stmt "procedure_names" procedure_names Typ.Procname.SQLiteList.deserialize + pp_procnames) + 3 + (pp_if stmt "freshly_captured" freshly_captured deserialize_freshly_captured + Format.pp_print_bool) + 4 + in ResultsDatabase.with_registered_statement select_all_source_files_statement ~f:(fun db stmt -> - let pp_procnames fmt procs = - F.fprintf fmt "@[" ; - List.iter ~f:(F.fprintf fmt "%a@," Typ.Procname.pp) procs ; - F.fprintf fmt "@]" - in - let pp_if title condition deserialize pp fmt column = - if condition then - F.fprintf fmt " @[%s@,%a@]@;" title pp (Sqlite3.column stmt column |> deserialize) - in - let pp_row fmt source_file = - F.fprintf fmt "%a@,%a%a%a%a" SourceFile.pp source_file - (pp_if "cfgs" cfgs Cfg.SQLite.deserialize Cfg.pp_proc_signatures) - 1 - (pp_if "type_environment" type_environment Tenv.SQLite.deserialize Tenv.pp_per_file) - 2 - (pp_if "procedure_names" procedure_names Typ.Procname.SQLiteList.deserialize pp_procnames) - 3 - (pp_if "freshly_captured" freshly_captured deserialize_freshly_captured - Format.pp_print_bool) - 4 + let pp fmt column = + let source_file = SourceFile.SQLite.deserialize column in + if filter source_file then pp_row stmt fmt source_file in - let rec aux fmt () = - match Sqlite3.step stmt with - | Sqlite3.Rc.ROW -> - let source_file = Sqlite3.column stmt 0 |> SourceFile.SQLite.deserialize in - if filter source_file then pp_row fmt source_file ; - aux fmt () - | DONE -> - () - | err -> - L.die InternalError "source_files_iter: %s (%s)" (Sqlite3.Rc.to_string err) - (Sqlite3.errmsg db) + let pp_result fmt stmt = + Container.iter stmt ~f:(pp fmt) + ~fold:(SqliteUtils.result_fold_single_column_rows db ~log:"printing all source files") in - Format.fprintf fmt "@[%a@]" aux () ) + F.fprintf fmt "@[%a@]" pp_result stmt ) diff --git a/infer/src/IR/Tenv.ml b/infer/src/IR/Tenv.ml index c1783a04f..81d32c9a9 100644 --- a/infer/src/IR/Tenv.ml +++ b/infer/src/IR/Tenv.ml @@ -132,8 +132,8 @@ let load_global () : t option = let load source = ResultsDatabase.with_registered_statement load_statement ~f:(fun db load_stmt -> SourceFile.SQLite.serialize source |> Sqlite3.bind load_stmt 1 - |> SqliteUtils.check_sqlite_error db ~log:"load bind source file" ; - SqliteUtils.sqlite_result_step ~finalize:false ~log:"Tenv.load" db load_stmt + |> SqliteUtils.check_result_code db ~log:"load bind source file" ; + SqliteUtils.result_single_column_option ~finalize:false ~log:"Tenv.load" db load_stmt |> Option.bind ~f:(fun x -> SQLite.deserialize x |> function Global -> load_global () | FileLocal tenv -> Some tenv ) ) diff --git a/infer/src/backend/Procedures.ml b/infer/src/backend/Procedures.ml index f1b97b589..669f9ff34 100644 --- a/infer/src/backend/Procedures.ml +++ b/infer/src/backend/Procedures.ml @@ -6,49 +6,40 @@ *) open! IStd module F = Format -module L = Logging - -let select_all_procedures_statement = ResultsDatabase.register_statement "SELECT * FROM procedures" let pp_all ?filter ~proc_name:proc_name_cond ~attr_kind ~source_file:source_file_cond ~proc_attributes fmt () = + let db = ResultsDatabase.get_database () in let filter = Filtering.mk_procedure_name_filter ~filter |> Staged.unstage in - ResultsDatabase.with_registered_statement select_all_procedures_statement ~f:(fun db stmt -> - let pp_if ?(new_line= false) condition title pp fmt x = - if condition then ( - if new_line then F.fprintf fmt "@[" else F.fprintf fmt "@[" ; - F.fprintf fmt "%s:@ %a@]@;" title pp x ) - in - let pp_column_if ?new_line condition title deserialize pp fmt column = - if condition then - (* repeat the [condition] check so that we do not deserialize if there's nothing to do *) - pp_if ?new_line condition title pp fmt (Sqlite3.column stmt column |> deserialize) - in - let pp_row fmt source_file proc_name = - let[@warning "-8"] Sqlite3.Data.TEXT proc_name_hum = Sqlite3.column stmt 1 in - Format.fprintf fmt "@[%s@,%a%a%a%a@]@\n" proc_name_hum - (pp_if source_file_cond "source_file" SourceFile.pp) - source_file - (pp_if proc_name_cond "proc_name" Typ.Procname.pp) - proc_name - (pp_column_if attr_kind "attribute_kind" Attributes.deserialize_attributes_kind - Attributes.pp_attributes_kind) - 2 - (pp_column_if ~new_line:true proc_attributes "attributes" - ProcAttributes.SQLite.deserialize ProcAttributes.pp) - 4 - in - let rec aux () = - match Sqlite3.step stmt with - | Sqlite3.Rc.ROW -> - let proc_name = Sqlite3.column stmt 0 |> Typ.Procname.SQLite.deserialize in - let source_file = Sqlite3.column stmt 3 |> SourceFile.SQLite.deserialize in - if filter source_file proc_name then pp_row fmt source_file proc_name ; - aux () - | DONE -> - () - | err -> - L.die InternalError "procedures_iter: %s (%s)" (Sqlite3.Rc.to_string err) - (Sqlite3.errmsg db) - in - aux () ) + let pp_if ?(new_line= false) condition title pp fmt x = + if condition then ( + if new_line then F.fprintf fmt "@[" else F.fprintf fmt "@[" ; + F.fprintf fmt "%s:@ %a@]@;" title pp x ) + in + let pp_column_if stmt ?new_line condition title deserialize pp fmt column = + if condition then + (* repeat the [condition] check so that we do not deserialize if there's nothing to do *) + pp_if ?new_line condition title pp fmt (Sqlite3.column stmt column |> deserialize) + in + let pp_row stmt fmt source_file proc_name = + let[@warning "-8"] Sqlite3.Data.TEXT proc_name_hum = Sqlite3.column stmt 1 in + Format.fprintf fmt "@[%s@,%a%a%a%a@]@\n" proc_name_hum + (pp_if source_file_cond "source_file" SourceFile.pp) + source_file + (pp_if proc_name_cond "proc_name" Typ.Procname.pp) + proc_name + (pp_column_if stmt attr_kind "attribute_kind" Attributes.deserialize_attributes_kind + Attributes.pp_attributes_kind) + 2 + (pp_column_if stmt ~new_line:true proc_attributes "attributes" + ProcAttributes.SQLite.deserialize ProcAttributes.pp) + 4 + in + (* we could also register this statement but it's typically used only once per run so just prepare + it inside the function *) + Sqlite3.prepare db "SELECT * FROM procedures" + |> Container.iter ~fold:(SqliteUtils.result_fold_rows db ~log:"print all procedures") ~f: + (fun stmt -> + let proc_name = Sqlite3.column stmt 0 |> Typ.Procname.SQLite.deserialize in + let source_file = Sqlite3.column stmt 3 |> SourceFile.SQLite.deserialize in + if filter source_file proc_name then pp_row stmt fmt source_file proc_name ) diff --git a/infer/src/base/MergeResults.ml b/infer/src/base/MergeResults.ml index f28cf5f48..d5b0c6e34 100644 --- a/infer/src/base/MergeResults.ml +++ b/infer/src/base/MergeResults.ml @@ -26,7 +26,7 @@ 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 db + |> SqliteUtils.check_result_code db ~log:(Printf.sprintf "copying procedures of database '%s'" db_file) @@ -38,19 +38,19 @@ let merge_source_files_table ~db_file = SELECT source_file, cfgs, type_environment, procedure_names, 1 FROM attached.source_files |} - |> SqliteUtils.check_sqlite_error db + |> SqliteUtils.check_result_code db ~log:(Printf.sprintf "copying source_files of database '%s'" db_file) let merge ~db_file = let main_db = ResultsDatabase.get_database () in Sqlite3.exec main_db (Printf.sprintf "ATTACH '%s' AS attached" db_file) - |> SqliteUtils.check_sqlite_error ~fatal:true main_db + |> SqliteUtils.check_result_code ~fatal:true main_db ~log:(Printf.sprintf "attaching database '%s'" db_file) ; merge_procedures_table ~db_file ; merge_source_files_table ~db_file ; Sqlite3.exec main_db "DETACH attached" - |> SqliteUtils.check_sqlite_error ~fatal:true main_db + |> SqliteUtils.check_result_code ~fatal:true main_db ~log:(Printf.sprintf "detaching database '%s'" db_file) ; () diff --git a/infer/src/base/ResultsDatabase.ml b/infer/src/base/ResultsDatabase.ml index b8cd150a9..728170c88 100644 --- a/infer/src/base/ResultsDatabase.ml +++ b/infer/src/base/ResultsDatabase.ml @@ -107,7 +107,7 @@ let register_statement = L.(die InternalError) "database not initialized" | Some (stmt, db) -> Sqlite3.clear_bindings stmt - |> SqliteUtils.check_sqlite_error db ~log:"clear bindings of prepared statement" ; + |> SqliteUtils.check_result_code db ~log:"clear bindings of prepared statement" ; (stmt, db) in fun stmt_fmt -> Printf.ksprintf k stmt_fmt @@ -116,7 +116,7 @@ let register_statement = let with_registered_statement get_stmt ~f = let stmt, db = get_stmt () in let result = f db stmt in - Sqlite3.reset stmt |> SqliteUtils.check_sqlite_error db ~log:"reset prepared statement" ; + Sqlite3.reset stmt |> SqliteUtils.check_result_code db ~log:"reset prepared statement" ; result diff --git a/infer/src/base/SqliteUtils.ml b/infer/src/base/SqliteUtils.ml index bc6fc7420..ee3c6f618 100644 --- a/infer/src/base/SqliteUtils.ml +++ b/infer/src/base/SqliteUtils.ml @@ -13,7 +13,7 @@ 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) db ~log rc = +let check_result_code ?(fatal= false) db ~log rc = match (rc : Sqlite3.Rc.t) with | OK | ROW -> () @@ -22,51 +22,64 @@ let check_sqlite_error ?(fatal= false) db ~log rc = 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 db ~log (Sqlite3.exec db stmt) with Error err -> + (* Call [check_result_code] with [fatal:true] and catch exceptions to rewrite the error message. This avoids allocating the error string when not needed. *) + try check_result_code ~fatal:true db ~log (Sqlite3.exec db stmt) with Error err -> error ~fatal:true "exec: %s (%s)" err (Sqlite3.errmsg db) let finalize db ~log stmt = - try check_sqlite_error ~fatal:true db ~log (Sqlite3.finalize stmt) with + try check_result_code ~fatal:true db ~log (Sqlite3.finalize stmt) with | Error err -> error ~fatal:true "finalize: %s (%s)" err (Sqlite3.errmsg db) | Sqlite3.Error err -> error ~fatal:true "finalize: %s: %s (%s)" log err (Sqlite3.errmsg db) -let sqlite_result_rev_list_step ?finalize:(do_finalize = true) db ~log stmt = - let rec aux rev_results = +let result_fold_rows ?finalize:(do_finalize = true) db ~log stmt ~init ~f = + let rec aux accum stmt = match Sqlite3.step stmt with | Sqlite3.Rc.ROW -> (* the operation returned a result, get it *) - let value = Sqlite3.column stmt 0 in - aux (value :: rev_results) + aux (f accum stmt) stmt | DONE -> - rev_results + accum | 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 db ~log stmt) ~f:(fun () -> aux []) - else aux [] + if do_finalize then + protect ~finally:(fun () -> finalize db ~log stmt) ~f:(fun () -> aux init stmt) + else aux init stmt -let sqlite_result_step ?finalize db ~log stmt = - match sqlite_result_rev_list_step ?finalize db ~log stmt with +let result_fold_single_column_rows ?finalize db ~log stmt ~init ~f = + result_fold_rows ?finalize db ~log stmt ~init ~f:(fun accum stmt -> + f accum (Sqlite3.column stmt 0) ) + + +let zero_or_one_row ~log = function | [] -> None | [x] -> Some x - | l -> - L.die InternalError "%s: zero or one result expected, got %d instead" log (List.length l) + | _ :: _ :: _ as l -> + L.die InternalError "%s: zero or one result expected, got %d rows instead" log + (List.length l) -let sqlite_unit_step ?finalize db ~log stmt = - match sqlite_result_rev_list_step ?finalize db ~log stmt with - | [] -> - () - | l -> - L.die InternalError "%s: exactly zero result expected, got %d instead" log (List.length l) +let result_option ?finalize db ~log ~read_row stmt = + IContainer.rev_map_to_list stmt ~f:read_row ~fold:(result_fold_rows ?finalize db ~log) + |> zero_or_one_row ~log + + +let result_single_column_option ?finalize db ~log stmt = + Container.to_list stmt ~fold:(result_fold_single_column_rows ?finalize db ~log) + |> zero_or_one_row ~log + + +let result_unit ?finalize db ~log stmt = + if + not (Container.is_empty stmt ~iter:(Container.iter ~fold:(result_fold_rows ?finalize db ~log))) + then L.die InternalError "%s: the SQLite query should not return any rows" log let db_close db = diff --git a/infer/src/base/SqliteUtils.mli b/infer/src/base/SqliteUtils.mli index c19f58c52..dd98020cf 100644 --- a/infer/src/base/SqliteUtils.mli +++ b/infer/src/base/SqliteUtils.mli @@ -7,31 +7,44 @@ open! IStd -(** 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. *) +(** 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. *) exception Error of string -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 check_result_code : ?fatal:bool -> Sqlite3.db -> log:string -> Sqlite3.Rc.t -> unit +(** Assert that the result is either [Sqlite3.Rc.OK] or [Sqlite3.Rc.ROW]. 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]. *) +(** Execute the given Sqlite [stmt] and check the result with {!check_result_code ~fatal:true}. *) val finalize : Sqlite3.db -> log:string -> Sqlite3.stmt -> unit -(** Finalize the given [stmt]. Raises [Error] on failure. *) +(** Finalize the given [stmt]. Raises {!Error} on failure. *) -val sqlite_result_rev_list_step : - ?finalize:bool -> Sqlite3.db -> log:string -> Sqlite3.stmt -> Sqlite3.Data.t 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 result_fold_rows : + ?finalize:bool -> Sqlite3.db -> log:string -> Sqlite3.stmt -> init:'a + -> f:('a -> Sqlite3.stmt -> 'a) -> 'a +(** Fold [f] over each row of the result. [f] must not access the database. *) -val sqlite_result_step : +val result_fold_single_column_rows : + ?finalize:bool -> Sqlite3.db -> log:string -> Sqlite3.stmt -> init:'b + -> f:('b -> Sqlite3.Data.t -> 'b) -> 'b +(** Like {!result_fold_rows} but pass column 0 of each row in the results to [f]. *) + +val result_option : + ?finalize:bool -> Sqlite3.db -> log:string -> read_row:(Sqlite3.stmt -> 'a) -> Sqlite3.stmt + -> 'a option +(** Same as {!result_fold_rows} but asserts that at most one row is returned. *) + +val result_single_column_option : ?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. *) +(** Same as {!result_fold_single_column_rows} but asserts that at most one row is returned. *) -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 result_unit : ?finalize:bool -> Sqlite3.db -> log:string -> Sqlite3.stmt -> unit +(** Same as {!result_fold_rows} but asserts that no row is returned. *) val db_close : Sqlite3.db -> unit -(** Close the given database and asserts that it was effective. Raises [Error] if not. *) +(** Close the given database and asserts that it was effective. Raises {!Error} if not. *) (** An API commonly needed to store and retrieve objects from the database *) module type Data = sig