[sqlite] use pname BLOB as the sqlite key, include readable pname for debug

Summary:
We were using the "filename" as the key because it's (kinda) unique *and* human
readable, but with the `infer explore --procedures` interface we don't really
need the human readable part anymore, so we can just use the OCaml marshalling
of the pname as the key. The human-readable version (sans unique-fying hash) is
now another column in the table, used to match procedure names in
`--procedures-filter`.

Reviewed By: sblackshear

Differential Revision: D7639158

fbshipit-source-id: e714605

infer/src/IR/Attributes.ml

@@ -55,7 +55,7 @@ let replace_statement =
   ResultsDatabase.register_statement
     {|
 INSERT OR REPLACE INTO procedures
-SELECT :pname, :akind, :sfile, :pattr
+SELECT :pname, :proc_name_hum, :akind, :sfile, :pattr
 FROM (
   SELECT NULL
   FROM (
@@ -67,15 +67,18 @@ FROM (
         OR (attr_kind = :akind AND source_file < :sfile) )|}
 
 
-let replace pname_blob akind loc_file attr_blob =
+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" ;
-      Sqlite3.bind replace_stmt 2 (* :akind *) (Sqlite3.Data.INT (int64_of_attributes_kind akind))
+      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" ;
+      Sqlite3.bind replace_stmt 3 (* :akind *) (Sqlite3.Data.INT (int64_of_attributes_kind akind))
       |> SqliteUtils.check_sqlite_error db ~log:"replace bind attribute kind" ;
-      Sqlite3.bind replace_stmt 3 (* :sfile *) loc_file
+      Sqlite3.bind replace_stmt 4 (* :sfile *) loc_file
       |> SqliteUtils.check_sqlite_error db ~log:"replace bind source file" ;
-      Sqlite3.bind replace_stmt 4 (* :pattr *) attr_blob
+      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 )
 
@@ -126,7 +129,7 @@ let store (attr: ProcAttributes.t) =
   let pkind = proc_kind_of_attr attr in
   let key = Typ.Procname.SQLite.serialize attr.proc_name in
   if should_try_to_update key pkind then
-    replace key pkind
+    replace attr.proc_name key pkind
       (SourceFile.SQLite.serialize attr.loc.Location.file)
       (ProcAttributes.SQLite.serialize attr)
 

infer/src/IR/Typ.ml

@@ -1156,7 +1156,7 @@ module Procname = struct
 
 
     let serialize pname =
-      let default () = Sqlite3.Data.TEXT (to_filename pname) in
+      let default () = Sqlite3.Data.BLOB (Marshal.to_string pname []) in
       Base.Hashtbl.find_or_add pname_to_key pname ~default
 
 

infer/src/backend/Procedures.ml

@@ -12,27 +12,27 @@ module L = Logging
 
 let select_all_procedures_like_statement =
   ResultsDatabase.register_statement
-    "SELECT * FROM procedures WHERE proc_name LIKE :pname_like AND source_file LIKE \
+    "SELECT * FROM procedures WHERE proc_name_hum LIKE :proc_name_like AND source_file LIKE \
      :source_file_like"
 
 
 let pp_all ?filter ~proc_name ~attr_kind ~source_file ~proc_attributes fmt () =
-  let source_file_like, pname_like =
+  let source_file_like, proc_name_like =
     match filter with
     | None ->
         let wildcard = Sqlite3.Data.TEXT "%" in
         (wildcard, wildcard)
     | Some filter_string ->
       match String.lsplit2 ~on:':' filter_string with
-      | Some (source_file_like, pname_like) ->
+      | Some (source_file_like, proc_name_like) ->
-          (Sqlite3.Data.TEXT source_file_like, Sqlite3.Data.TEXT pname_like)
+          (Sqlite3.Data.TEXT source_file_like, Sqlite3.Data.TEXT proc_name_like)
       | None ->
           L.die UserError
             "Invalid filter for procedures. Please see the documentation for --procedures-filter \
              in `infer explore --help`."
   in
   ResultsDatabase.with_registered_statement select_all_procedures_like_statement ~f:(fun db stmt ->
-      Sqlite3.bind stmt 1 (* :pname_like *) pname_like
+      Sqlite3.bind stmt 1 (* :proc_name_like *) proc_name_like
       |> SqliteUtils.check_sqlite_error db ~log:"procedures filter pname bind" ;
       Sqlite3.bind stmt 2 (* :source_file_like *) source_file_like
       |> SqliteUtils.check_sqlite_error db ~log:"procedures filter source file bind" ;
@@ -45,19 +45,18 @@ let pp_all ?filter ~proc_name ~attr_kind ~source_file ~proc_attributes fmt () =
         match Sqlite3.step stmt with
         | Sqlite3.Rc.ROW ->
             let proc_name_hum =
-              (* same as proc_name for now, will change later *)
+              match[@warning "-8"] Sqlite3.column stmt 1 with Sqlite3.Data.TEXT s -> s
-              match[@warning "-8"] Sqlite3.column stmt 0 with Sqlite3.Data.TEXT s -> s
             in
             Format.fprintf fmt "@[<h2>%s:@ %a%a%a%a@]@\n" proc_name_hum
               (pp_if source_file SourceFile.SQLite.deserialize SourceFile.pp)
-              2
+              3
               (pp_if proc_name Typ.Procname.SQLite.deserialize Typ.Procname.pp)
               0
               (pp_if attr_kind Attributes.deserialize_attributes_kind Attributes.pp_attributes_kind)
-              1
+              2
               (pp_if ~newline:true proc_attributes ProcAttributes.SQLite.deserialize
                  ProcAttributes.pp)
-              3 ;
+              4 ;
             aux ()
         | DONE ->
             ()

infer/src/base/MergeResults.ml

@@ -18,7 +18,7 @@ let merge_procedures_table ~db_file =
   Sqlite3.exec db
     {|
 INSERT OR REPLACE INTO procedures
-SELECT sub.proc_name, sub.attr_kind, sub.source_file, sub.proc_attributes
+SELECT sub.proc_name, sub.proc_name_hum, sub.attr_kind, sub.source_file, sub.proc_attributes
 FROM (
   attached.procedures AS sub
   LEFT OUTER JOIN procedures AS main

infer/src/base/ResultsDatabase.ml

@@ -19,6 +19,7 @@ let database_fullpath = Config.results_dir ^/ database_filename
 let procedures_schema =
   {|CREATE TABLE IF NOT EXISTS procedures
   ( proc_name TEXT PRIMARY KEY
+  , proc_name_hum TEXT
   , attr_kind INTEGER NOT NULL
   , source_file TEXT NOT NULL
   , proc_attributes BLOB NOT NULL )|}