update opam deps

Summary:
Update opam dependencies, in particular core to v0.9. Make
corresponding changes to infer. Update opam.lock.

Reviewed By: jvillard

Differential Revision: D5325770

fbshipit-source-id: 506588c
master
Josh Berdine 8 years ago committed by Facebook Github Bot
parent 301ebd4cd5
commit e04dd37df3

@ -181,7 +181,7 @@ AC_PROG_OCAMLLEX
AC_ASSERT_PROG([ocamllex], [$OCAMLLEX])
AC_PATH_TOOL([MENHIR], [menhir], [no])
AC_ASSERT_PROG([menhir], [$MENHIR])
AC_ASSERT_OCAML_PKG([atdgen], [], [1.6.0])
AC_ASSERT_OCAML_PKG([atdgen], [], [])
AC_ASSERT_OCAML_PKG([biniou])
AC_ASSERT_OCAML_PKG([camlzip], [zip])
AC_ASSERT_OCAML_PKG([easy-format])

@ -407,7 +407,7 @@ let pp_graph_dotty (g: t) fmt => {
let save_call_graph_dotty source (g: t) => {
let fname_dot =
DB.Results_dir.path_to_filename (DB.Results_dir.Abs_source_dir source) ["call_graph.dot"];
let outc = open_out (DB.filename_to_string fname_dot);
let outc = Out_channel.create (DB.filename_to_string fname_dot);
let fmt = F.formatter_of_out_channel outc;
pp_graph_dotty g fmt;
Out_channel.close outc

@ -132,7 +132,7 @@ let store_to_file (filename: DB.filename) (tenv: t) => {
Serialization.write_to_file tenv_serializer filename data::tenv;
if Config.debug_mode {
let debug_filename = DB.filename_to_string (DB.filename_add_suffix filename ".debug");
let out_channel = open_out debug_filename;
let out_channel = Out_channel.create debug_filename;
let fmt = Format.formatter_of_out_channel out_channel;
Format.fprintf fmt "%a" pp tenv;
Out_channel.close out_channel

@ -77,7 +77,7 @@ let output_json_makefile_stats clusters => {
let file_stats =
`Assoc [("files", `Int num_files), ("procedures", `Int num_procs), ("lines", `Int num_lines)];
/* write stats file to disk, intentionally overwriting old file if it already exists */
let f = open_out (Filename.concat Config.results_dir Config.proc_stats_filename);
let f = Out_channel.create (Filename.concat Config.results_dir Config.proc_stats_filename);
Yojson.Basic.pretty_to_channel f file_stats
};

@ -136,7 +136,7 @@ let iterate_callbacks call_graph exe_env =
| Some pdesc -> Some pdesc
| None when Config.dynamic_dispatch = `Lazy ->
Option.bind (Specs.get_summary proc_name)
(fun summary -> summary.Specs.proc_desc_option)
~f:(fun summary -> summary.Specs.proc_desc_option)
| None -> None in
let callbacks = {

@ -43,7 +43,7 @@ let pp_epilog fmt () =
F.fprintf fmt "@.clean:@.\trm -f $(CLUSTERS)@."
let create_cluster_makefile (clusters: Cluster.t list) (fname: string) =
let outc = open_out fname in
let outc = Out_channel.create fname in
let fmt = Format.formatter_of_out_channel outc in
let do_cluster cluster_nr cluster =
F.fprintf fmt "#%s@\n" (DB.source_dir_to_string cluster);

@ -960,7 +960,7 @@ let dotty_prop_to_str prop cycle =
(* create a dotty file with a single proposition *)
let dotty_prop_to_dotty_file fname prop cycle =
try
let out_dot = open_out fname in
let out_dot = Out_channel.create fname in
let fmt_dot = Format.formatter_of_out_channel out_dot in
pp_dotty_prop fmt_dot (prop, cycle);
Out_channel.close out_dot
@ -978,7 +978,7 @@ let pp_proplist_parsed2dotty_file filename plist =
F.fprintf f "@\n /* size=\"12,7\"; ratio=fill;*/ @\n";
ignore (List.map ~f:(pp_dotty f Generic_proposition) plist);
F.fprintf f "@\n}" in
let outc = open_out filename in
let outc = Out_channel.create filename in
let fmt = F.formatter_of_out_channel outc in
F.fprintf fmt "#### Dotty version: ####@.%a@.@." pp_list plist;
Out_channel.close outc
@ -1080,7 +1080,7 @@ let print_icfg source fmt cfg =
Cfg.iter_all_nodes ~sorted:true print_node cfg
let write_icfg_dotty_to_file source cfg fname =
let chan = open_out fname in
let chan = Out_channel.create fname in
let fmt = Format.formatter_of_out_channel chan in
(* avoid phabricator thinking this file was generated by substituting substring with %s *)
F.fprintf fmt "/* %@%s */@\ndigraph iCFG {@\n" "generated";
@ -1121,7 +1121,7 @@ let pp_speclist_dotty f (splist: Prop.normal Specs.spec list) =
let pp_speclist_to_file (filename : DB.filename) spec_list =
let pp_simple_saved = !Config.pp_simple in
Config.pp_simple := true;
let outc = open_out (DB.filename_to_string (DB.filename_add_suffix filename ".dot")) in
let outc = Out_channel.create (DB.filename_to_string (DB.filename_add_suffix filename ".dot")) in
let fmt = F.formatter_of_out_channel outc in
let () = F.fprintf fmt "#### Dotty version: ####@\n%a@\n@\n" (pp_speclist_dotty) spec_list in
Out_channel.close outc;

@ -412,7 +412,7 @@ and _exp_rv_dexp tenv (_seen : Exp.Set.t) node e : DExp.t option =
_exp_rv_dexp tenv seen node e1
| Exp.Sizeof {typ; dynamic_length; subtype} ->
if verbose then (L.d_str "exp_rv_dexp: type "; Sil.d_exp e; L.d_ln ());
Some (DExp.Dsizeof (typ, Option.bind dynamic_length (_exp_rv_dexp tenv seen node), subtype))
Some (DExp.Dsizeof (typ, Option.bind dynamic_length ~f:(_exp_rv_dexp tenv seen node), subtype))
| _ ->
if verbose then (L.d_str "exp_rv_dexp: no match for "; Sil.d_exp e; L.d_ln ());
None

@ -69,7 +69,7 @@ module FileContainsStringMatcher = struct
let file_contains regexp file_in =
let rec loop () =
try
(Str.search_forward regexp (input_line file_in) 0) >= 0
(Str.search_forward regexp (In_channel.input_line_exn file_in) 0) >= 0
with
| Not_found -> loop ()
| End_of_file -> false in
@ -87,7 +87,7 @@ module FileContainsStringMatcher = struct
SourceFile.Map.find source_file !source_map
with Not_found ->
try
let file_in = open_in (SourceFile.to_abs_path source_file) in
let file_in = In_channel.create (SourceFile.to_abs_path source_file) in
let pattern_found = file_contains regexp file_in in
In_channel.close file_in;
source_map := SourceFile.Map.add source_file pattern_found !source_map;

@ -1453,7 +1453,7 @@ let do_analysis_closures exe_env : Tasks.closure list =
| Some pdesc -> Some pdesc
| None when Config.dynamic_dispatch = `Lazy ->
Option.bind (Specs.get_summary proc_name)
(fun summary -> summary.Specs.proc_desc_option)
~f:(fun summary -> summary.Specs.proc_desc_option)
| None -> None in
let analyze_ondemand _ proc_desc =
let proc_name = Procdesc.get_proc_name proc_desc in
@ -1578,7 +1578,7 @@ let print_stats_cfg proc_shadowed source cfg =
let source_dir = DB.source_dir_from_source_file source in
let stats_file = DB.source_dir_get_internal_file source_dir ".stats" in
try
let outc = open_out (DB.filename_to_string stats_file) in
let outc = Out_channel.create (DB.filename_to_string stats_file) in
let fmt = F.formatter_of_out_channel outc in
print_file_stats fmt ();
Out_channel.close outc

@ -81,7 +81,7 @@ let add_multilink_attr ~stats src dst =
let create_link ~stats src dst =
if link_exists dst then Unix.unlink dst;
Unix_.symlink ~src ~dst;
Unix.symlink ~src ~dst;
(* Set the accessed and modified time of the original file slightly in the past. Due to
the coarse precision of the timestamps, it is possible for the source and destination of a
link to have the same modification time. When this happens, the files will be considered to

@ -27,11 +27,11 @@ struct
Hashtbl.create 1
let read_file fname =
let cin = open_in fname in
let cin = In_channel.create fname in
let lines = ref [] in
try
while true do
let line_raw = input_line cin in
let line_raw = In_channel.input_line_exn cin in
let line =
let len = String.length line_raw in
if len > 0 && Char.equal (String.get line_raw (len -1)) '\013' then

@ -394,7 +394,7 @@ end = struct
if type_opt_is_unsigned t then add_lt_minus1_e e
| Sil.Estruct (fsel, _), t ->
let get_field_type f =
Option.bind t (fun t' ->
Option.bind t ~f:(fun t' ->
Option.map ~f:fst @@ Typ.Struct.get_field_type_and_annotation ~lookup f t'
) in
List.iter ~f:(fun (f, se) -> strexp_extract (se, get_field_type f)) fsel
@ -742,7 +742,7 @@ let check_lt_normalized tenv prop e1 e2 =
We use this to distinguish among different queries. *)
let get_smt_key a p =
let tmp_filename = Filename.temp_file "smt_query" ".cns" in
let outc_tmp = open_out tmp_filename in
let outc_tmp = Out_channel.create tmp_filename in
let fmt_tmp = F.formatter_of_out_channel outc_tmp in
let () = F.fprintf fmt_tmp "%a%a" (Sil.pp_atom Pp.text) a (Prop.pp_prop Pp.text) p in
Out_channel.close outc_tmp;
@ -759,7 +759,7 @@ let check_atom tenv prop a0 =
DB.Results_dir.path_to_filename
(DB.Results_dir.Abs_source_dir source)
[(key ^ ".cns")] in
let outc = open_out (DB.filename_to_string key_filename) in
let outc = Out_channel.create (DB.filename_to_string key_filename) in
let fmt = F.formatter_of_out_channel outc in
L.d_str ("ID: "^key); L.d_ln ();
L.d_str "CHECK_ATOM_BOUND: "; Sil.d_atom a; L.d_ln ();

@ -33,7 +33,7 @@ module Jprop = struct
[@@deriving compare]
(** Comparison for joined_prop *)
let compare jp1 jp2 = compare_t (fun _ _ -> 0) jp1 jp2
let compare jp1 jp2 = compare (fun _ _ -> 0) jp1 jp2
(** Return true if the two join_prop's are equal *)
let equal jp1 jp2 =

@ -661,7 +661,7 @@ let resolve_and_analyze
~f:(fun callee_proc_desc ->
Cfg.specialize_types callee_proc_desc resolved_pname args)
(Ondemand.get_proc_desc callee_proc_name)) in
Option.bind resolved_proc_desc_option analyze in
Option.bind resolved_proc_desc_option ~f:analyze in
let resolved_pname = match callee_proc_name with
| Typ.Procname.Java callee_proc_name_java ->
Typ.Procname.Java

@ -178,7 +178,7 @@ let hidden_descs_list = ref []
(** add [desc] to the one relevant parse_tag_desc_lists for the purposes of parsing, and, in the
case of InferCommand, include [desc] in --help only for the relevant sections. *)
let add parse_mode sections desc =
let desc_list = List.Assoc.find_exn parse_mode_desc_lists parse_mode in
let desc_list = List.Assoc.find_exn ~equal:equal_parse_mode parse_mode_desc_lists parse_mode in
desc_list := desc :: !desc_list;
let add_to_section (command, section) =
let sections = List.Assoc.find_exn ~equal:equal_command help_sections_desc_lists command in
@ -845,7 +845,7 @@ let show_manual ?internal_section format default_doc command_opt =
| None ->
default_doc
| Some command ->
match List.Assoc.find_exn !subcommands command with
match List.Assoc.find_exn ~equal:equal_command !subcommands command with
| (Some command_doc, _, _) ->
command_doc
| (None, _, _) ->
@ -885,7 +885,7 @@ let show_manual ?internal_section format default_doc command_opt =
[] in
match command_opt with
| Some command ->
let sections = List.Assoc.find_exn help_sections_desc_lists command in
let sections = List.Assoc.find_exn ~equal:equal_command help_sections_desc_lists command in
SectionMap.fold (fun section descs result ->
`S section ::
(if String.equal section Cmdliner.Manpage.s_options then blocks else []) @

@ -35,7 +35,7 @@ let append_crc_cutoff ?(key="") name =
let dot_crc_len = 1 + 32
let strip_crc str =
Core.Std.String.slice str 0 (- dot_crc_len)
String.slice str 0 (- dot_crc_len)
let string_crc_has_extension ~ext name_crc =
let name = strip_crc name_crc in

@ -7,7 +7,7 @@
* of patent rights can be found in the PATENTS file in the same directory.
*)
include Core.Std
include Core
module Unix_ = struct
@ -40,10 +40,6 @@ module Unix_ = struct
Unix.waitpid (create_process_redirect ~prog ~args ?stdin ?stdout ?stderr ())
|> Unix.Exit_or_signal.or_error |> ok_exn
(* Unix.symlink has ambiguous function application when the optional argument is not provided, but
the optional argument is not used in the implementation anyway. *)
let symlink ~src ~dst = Unix.symlink ?to_dir:None ~src ~dst
end
module List_ = struct

@ -271,7 +271,7 @@ let setup_log_file () =
let fmt, chan, preexisting_logfile =
if Config.buck_cache_mode then
(* suppress log file in order not to cause flakiness in the Buck cache *)
let devnull_chan = open_out "/dev/null" in
let devnull_chan = Out_channel.create "/dev/null" in
let devnull_fmt = F.formatter_of_out_channel devnull_chan in
devnull_fmt, devnull_chan, true
else

@ -45,8 +45,9 @@ let read ::dir :option t => {
/* Write a multilink file in the given directory */
let write multilinks ::dir => {
let fname = Filename.concat dir multilink_file_name;
let outc = open_out fname;
String.Table.iteri f::(fun key::_ data::src => output_string outc (src ^ "\n")) multilinks;
let outc = Out_channel.create fname;
String.Table.iteri
f::(fun key::_ data::src => Out_channel.output_string outc (src ^ "\n")) multilinks;
Out_channel.close outc
};

@ -24,7 +24,7 @@ let print_error_and_exit ?(exit_code=1) fmt =
terminate. The standard out and error are not redirected. If the command fails to execute,
print an error message and exit. *)
let create_process_and_wait ~prog ~args =
Unix.fork_exec ~prog ~args:(prog :: args) ()
Unix.fork_exec ~prog ~argv:(prog :: args) ()
|> Unix.waitpid
|> function
| Ok () -> ()
@ -85,7 +85,7 @@ let run_jobs_in_parallel ?(fail_on_failed_job=false) jobs_stack gen_prog prog_to
match Unix.fork () with
| `In_the_child ->
Option.iter dir_opt ~f:Unix.chdir ;
Unix.exec ~prog ~args:(prog :: args) ~env ~use_path:false
Unix.exec ~prog ~argv:(prog :: args) ~env ~use_path:false
|> Unix.handle_unix_error
|> never_returns
| `In_the_parent pid_child ->
@ -108,7 +108,7 @@ let pipeline ~producer_prog ~producer_args ~consumer_prog ~consumer_args =
Unix.close pipe_out ;
Unix.close pipe_in ;
(* exec producer *)
never_returns (Unix.exec ~prog:producer_prog ~args:producer_args ())
never_returns (Unix.exec ~prog:producer_prog ~argv:producer_args ())
| `In_the_parent producer_pid ->
match Unix.fork () with
| `In_the_child ->
@ -118,7 +118,7 @@ let pipeline ~producer_prog ~producer_args ~consumer_prog ~consumer_args =
Unix.close pipe_out ;
Unix.close pipe_in ;
(* exec consumer *)
never_returns (Unix.exec ~prog:consumer_prog ~args:consumer_args ())
never_returns (Unix.exec ~prog:consumer_prog ~argv:consumer_args ())
| `In_the_parent consumer_pid ->
(* close parent's copy of pipe ends *)
Unix.close pipe_out ;

@ -77,7 +77,7 @@ let create_serializer (key : Key.t) : 'a serializer =
The writes are synchronized with a .lock file. *)
let read_from_file (fname : DB.filename) : 'a option =
let fname_str = DB.filename_to_string fname in
match open_in_bin fname_str with
match In_channel.create ~binary:true fname_str with
| exception Sys_error _ ->
None
| inc ->

@ -28,10 +28,10 @@ let read_file fname =
| None -> ()
| Some cin -> In_channel.close cin in
try
let cin = open_in fname in
let cin = In_channel.create fname in
cin_ref := Some cin;
while true do
let line = input_line cin in
let line = In_channel.input_line_exn cin in
res := line :: !res
done;
assert false
@ -58,14 +58,14 @@ let copy_file fname_from fname_to =
| Some cout -> Out_channel.close cout
end in
try
let cin = open_in fname_from in
let cin = In_channel.create fname_from in
cin_ref := Some cin;
let cout = open_out fname_to in
let cout = Out_channel.create fname_to in
cout_ref := Some cout;
while true do
let line = input_line cin in
output_string cout line;
output_char cout '\n';
let line = In_channel.input_line_exn cin in
Out_channel.output_string cout line;
Out_channel.output_char cout '\n';
incr res
done;
assert false
@ -80,13 +80,13 @@ let copy_file fname_from fname_to =
(** type for files used for printing *)
type outfile =
{ fname : string; (** name of the file *)
out_c : out_channel; (** output channel *)
out_c : Out_channel.t; (** output channel *)
fmt : F.formatter (** formatter for printing *) }
(** create an outfile for the command line *)
let create_outfile fname =
try
let out_c = open_out fname in
let out_c = Out_channel.create fname in
let fmt = F.formatter_of_out_channel out_c in
Some { fname = fname; out_c = out_c; fmt = fmt }
with Sys_error _ ->
@ -181,7 +181,7 @@ let dir_is_empty path =
let is_empty = ref true in
(try
while !is_empty;
do if not (List.mem ~equal:String.equal["."; ".."] (Unix.readdir dir_handle)) then
do if not (Option.value_map (Unix.readdir_opt dir_handle) ~default:false ~f:(List.mem ~equal:String.equal ["."; ".."])) then
is_empty := false;
done;
with End_of_file -> ()
@ -220,7 +220,7 @@ let write_json_to_file destfile json =
let consume_in chan_in =
try
while true do input_line chan_in |> ignore done
while true do In_channel.input_line_exn chan_in |> ignore done
with End_of_file -> ()
let with_process_in command read =
@ -265,7 +265,7 @@ let realpath ?(warn_on_error=true) path =
| exception Unix.Unix_error (code, f, arg) ->
if warn_on_error then
F.eprintf
"WARNING: Failed to resolve file %s with \"%s\" @\n@." arg (Unix.error_message code);
"WARNING: Failed to resolve file %s with \"%s\" @\n@." arg (Unix.Error.message code);
(* cache failures as well *)
Hashtbl.add realpath_cache path (Error (code, f, arg));
raise (Unix.Unix_error (code, f, arg))
@ -308,7 +308,7 @@ let write_file_with_locking ?(delete=false) ~f:do_write fname =
Unix.ftruncate file_descr ~len:Int64.zero;
let outc = Unix.out_channel_of_descr file_descr in
do_write outc;
flush outc;
Out_channel.flush outc;
ignore (Unix.flock file_descr Unix.Flock_command.unlock)
);
);
@ -321,15 +321,15 @@ let rec rmtree name =
| S_DIR ->
let dir = Unix.opendir name in
let rec rmdir dir =
match Unix.readdir dir with
| entry ->
match Unix.readdir_opt dir with
| Some entry ->
if not (String.equal entry Filename.current_dir_name ||
String.equal entry Filename.parent_dir_name)
then (
rmtree (name ^/ entry)
);
rmdir dir
| exception End_of_file ->
| None ->
Unix.closedir dir ;
Unix.rmdir name in
rmdir dir

@ -34,7 +34,7 @@ val filename_to_relative : root:string -> string -> string option
(** type for files used for printing *)
type outfile =
{ fname : string; (** name of the file *)
out_c : out_channel; (** output channel *)
out_c : Out_channel.t; (** output channel *)
fmt : Format.formatter (** formatter for printing *) }
(** create an outfile for the command line, the boolean indicates whether to do demangling when closing the file *)
@ -62,9 +62,9 @@ val with_file_out : string -> f:(Out_channel.t -> 'a) -> 'a
val write_json_to_file : string -> Yojson.Basic.json -> unit
val consume_in : in_channel -> unit
val consume_in : In_channel.t -> unit
val with_process_in : string -> (in_channel -> 'a) -> ('a * Unix.Exit_or_signal.t)
val with_process_in : string -> (In_channel.t -> 'a) -> ('a * Unix.Exit_or_signal.t)
val shell_escape_command : string list -> string
@ -88,7 +88,7 @@ val compare_versions : string -> string -> int
(** Lock file passed as argument and write into it using [f]. If [delete] then the file is unlinked
once this is done. *)
val write_file_with_locking : ?delete:bool -> f:(out_channel -> unit) -> string -> unit
val write_file_with_locking : ?delete:bool -> f:(Out_channel.t -> unit) -> string -> unit
(** [rmtree path] removes [path] and, if [path] is a directory, recursively removes its contents *)
val rmtree : string -> unit

@ -62,7 +62,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let is_compile_time_constructed pdesc pv =
let init_pname = Pvar.get_initializer_pname pv in
match Option.bind init_pname (Summary.read_summary pdesc) with
match Option.bind init_pname ~f:(Summary.read_summary pdesc) with
| Some (Domain.BottomSiofTrace.Bottom, _)->
(* we analyzed the initializer for this global and found that it doesn't require any runtime
initialization so cannot participate in SIOF *)

@ -345,7 +345,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
"openRawResource";
"openRawResourceFd"
] in
not (List.mem non_functional_resource_methods method_name)
not (List.mem ~equal:String.equal non_functional_resource_methods method_name)
| _ ->
false
end

@ -136,7 +136,7 @@ let run_plugin_and_frontend source_path frontend clang_args => {
let basename = source_path ^ ".ast";
/* Emit the clang command with the extra args piped to infer-as-clang */
let frontend_script_fname = Printf.sprintf "%s.sh" basename;
let debug_script_out = open_out frontend_script_fname;
let debug_script_out = Out_channel.create frontend_script_fname;
let debug_script_fmt = Format.formatter_of_out_channel debug_script_out;
let biniou_fname = Printf.sprintf "%s.biniou" basename;
Format.fprintf debug_script_fmt "%s \\@\n > %s@\n" clang_command biniou_fname;

@ -107,7 +107,7 @@ let normalize ::prog ::args :list action_item => {
let consume_input i =>
try (
while true {
let line = input_line i;
let line = In_channel.input_line_exn i;
/* keep only commands and errors */
if (Str.string_match commands_or_errors line 0) {
normalized_commands := [one_line line, ...!normalized_commands]

@ -35,7 +35,7 @@ let parse_al_file fname channel : CTL.al_file option =
let already_imported_files = ref []
let rec parse_import_file import_file channel =
if List.mem !already_imported_files import_file then
if List.mem ~equal:String.equal !already_imported_files import_file then
failwith ("Cyclic imports: file '" ^ import_file ^ "' was already imported.")
else (
match parse_al_file import_file channel with
@ -61,7 +61,7 @@ and collect_all_macros_and_paths imports curr_file_macros curr_file_paths =
and parse_imports imports_files =
let parse_one_import_file fimport (macros, paths) =
L.(debug Linters Medium) " Loading import macros from file %s@\n" fimport;
let in_channel = open_in fimport in
let in_channel = In_channel.create fimport in
let parsed_macros, parsed_paths = parse_import_file fimport in_channel in
In_channel.close in_channel;
let macros = List.append parsed_macros macros in
@ -92,7 +92,7 @@ let parse_ctl_file linters_def_file channel : CFrontend_errors.linter list =
let parse_ctl_files linters_def_files : CFrontend_errors.linter list =
let collect_parsed_linters linters_def_file linters =
L.(debug Linters Medium) "Loading linters rules from %s@\n" linters_def_file;
let in_channel = open_in linters_def_file in
let in_channel = In_channel.create linters_def_file in
let parsed_linters = parse_ctl_file linters_def_file in_channel in
In_channel.close in_channel;
List.append parsed_linters linters in

@ -140,7 +140,7 @@ let mk_sil_global_var {CFrontend_config.source_file} ?(mk_name=fun _ x -> x)
let is_constexpr = var_decl_info.Clang_ast_t.vdi_is_const_expr in
let is_pod =
CAst_utils.get_desugared_type qt.Clang_ast_t.qt_type_ptr
|> Fn.flip Option.bind (function
|> Option.bind ~f:(function
| Clang_ast_t.RecordType(_, decl_ptr) -> CAst_utils.get_decl decl_ptr
| _ -> None)
|> Option.value_map ~default:true ~f:(function

@ -305,7 +305,7 @@ module Debug = struct
L.progress "%s@\n" ast_str;
let quit_token = "q" in
L.progress "Press Enter to continue or type %s to quit... @?" quit_token;
match read_line () |> String.lowercase with
match In_channel.input_line_exn In_channel.stdin |> String.lowercase with
| s when String.equal s quit_token -> exit 0
| _ ->
(* Remove the line at the bottom of terminal with the debug instructions *)
@ -491,7 +491,7 @@ let save_dotty_when_in_debug_mode source_file =
let source_file_basename = Filename.basename (SourceFile.to_abs_path source_file) in
let file = dotty_dir ^/ (source_file_basename ^ ".dot") in
let dotty = Debug.EvaluationTracker.DottyPrinter.dotty_of_ctl_evaluation tracker in
Utils.with_file_out file ~f:(fun oc -> output_string oc dotty)
Utils.with_file_out file ~f:(fun oc -> Out_channel.output_string oc dotty)
| _ -> ()
(* Helper functions *)

@ -458,7 +458,7 @@ struct
assert false)
| None -> None in
let name = QualifiedCppName.to_qual_string qual_name in
let function_attr_opt = Option.bind decl_opt get_annotate_attr_arg in
let function_attr_opt = Option.bind decl_opt ~f:get_annotate_attr_arg in
match function_attr_opt with
| Some attr when CTrans_models.is_modeled_attribute attr ->
Some (Typ.Procname.from_string_c_fun attr)
@ -878,8 +878,8 @@ struct
let res_trans_p = List.map ~f:(instruction' trans_state_param) params_stmt in
res_trans_callee :: res_trans_p in
match Option.bind callee_pname_opt
(CTrans_utils.builtin_trans
trans_state_pri sil_loc si function_type result_trans_subexprs) with
~f:(CTrans_utils.builtin_trans
trans_state_pri sil_loc si function_type result_trans_subexprs) with
| Some builtin -> builtin
| None ->
let is_cf_retain_release =
@ -897,7 +897,7 @@ struct
else act_params in
let res_trans_call =
let cast_trans_fun = cast_trans act_params sil_loc function_type in
match Option.bind callee_pname_opt cast_trans_fun with
match Option.bind callee_pname_opt ~f:cast_trans_fun with
| Some (instr, cast_exp) ->
{ empty_res_trans with
instrs = [instr];

@ -287,7 +287,7 @@ let rec typ_string_of_type_ptr type_ptr =
let open Clang_ast_t in
match CAst_utils.get_type type_ptr with
| Some BuiltinType (_, bt) ->
(match List.Assoc.find builtin_type_kind_assoc bt with
(match List.Assoc.find ~equal:Poly.equal builtin_type_kind_assoc bt with
| Some abt -> builtin_kind_to_string abt
| None -> "")
| Some PointerType (_, qt)

@ -53,7 +53,7 @@ type 'a t =
} [@@deriving compare]
(* Ignore the extension field, which is a pure instrumentation *)
let compare t1 t2 = compare_t (fun _ _ -> 0) t1 t2
let compare t1 t2 = compare (fun _ _ -> 0) t1 t2
let equal t1 t2 = Int.equal (compare t1 t2) 0

@ -51,7 +51,7 @@ let capture compiler ~prog ~args =
let new_path = Config.wrappers_dir ^ ":" ^ (Sys.getenv_exn path_var) in
let extended_env = `Extend [path_var, new_path] in
L.environment_info "Running command %s with env:@\n%a@\n@." prog pp_extended_env extended_env;
Unix.fork_exec ~prog:prog ~args:(prog::args) ~env:extended_env ()
Unix.fork_exec ~prog:prog ~argv:(prog::args) ~env:extended_env ()
|> Unix.waitpid
|> function
| Ok () -> ()

@ -35,7 +35,7 @@ let quote style =>
let mk_arg_file prefix style args => {
let file = Filename.temp_file prefix ".txt";
let write_args outc =>
output_string outc (List.map f::(quote style) args |> String.concat sep::" ");
Out_channel.output_string outc (List.map f::(quote style) args |> String.concat sep::" ");
Utils.with_file_out file f::write_args |> ignore;
L.(debug Capture Medium) "Clang options stored in file %s@\n" file;
file

@ -44,7 +44,7 @@ let decode_json_file (database : t) json_format =
| `Raw _ ->
s
| `Escaped _ ->
Utils.with_process_in (Printf.sprintf "/bin/sh -c 'printf \"%%s\" %s'" s) input_line
Utils.with_process_in (Printf.sprintf "/bin/sh -c 'printf \"%%s\" %s'" s) In_channel.input_line_exn
|> fst in
L.(debug Capture Quiet) "parsing compilation database from %s@\n" json_path;
let exit_format_error () =

@ -35,12 +35,12 @@ let build_system_exe_assoc = [
let build_system_of_exe_name name =
try
List.Assoc.find_exn (List.Assoc.inverse build_system_exe_assoc) name
List.Assoc.find_exn ~equal:String.equal (List.Assoc.inverse build_system_exe_assoc) name
with Not_found ->
invalid_argf "Unsupported build command %s" name
let string_of_build_system build_system =
List.Assoc.find_exn build_system_exe_assoc build_system
List.Assoc.find_exn ~equal:equal_build_system build_system_exe_assoc build_system
(* based on the build_system and options passed to infer, we run in different driver modes *)
type mode =
@ -121,8 +121,8 @@ let clean_results_dir () =
not (String.equal (Filename.basename name) "report.json")
&& List.exists ~f:(Filename.check_suffix name) suffixes_to_delete in
let rec clean name =
let rec cleandir dir = match Unix.readdir dir with
| entry ->
let rec cleandir dir = match Unix.readdir_opt dir with
| Some entry ->
if should_delete_dir entry then (
Utils.rmtree (name ^/ entry)
) else if not (String.equal entry Filename.current_dir_name
@ -130,7 +130,7 @@ let clean_results_dir () =
clean (name ^/ entry)
);
cleandir dir (* next entry *)
| exception End_of_file ->
| None ->
Unix.closedir dir in
match Unix.opendir name with
| dir ->
@ -185,7 +185,7 @@ let touch_start_file_unless_continue () =
let run_command ~prog ~args cleanup =
Unix.waitpid (Unix.fork_exec ~prog ~args:(prog :: args) ())
Unix.waitpid (Unix.fork_exec ~prog ~argv:(prog :: args) ())
|> fun status
-> cleanup status
; ok_exn (Unix.Exit_or_signal.or_error status)
@ -338,7 +338,7 @@ let report () =
"--project-root"; Config.project_root;
"--results-dir"; Config.results_dir
] in
if is_error (Unix.waitpid (Unix.fork_exec ~prog ~args:(prog :: args) ())) then
if is_error (Unix.waitpid (Unix.fork_exec ~prog ~argv:(prog :: args) ())) then
L.external_error
"** Error running the reporting script:@\n** %s %s@\n** See error above@."
prog (String.concat ~sep:" " args)

@ -152,7 +152,7 @@ let capture ~prog ~args =
L.(debug Capture Quiet) "Running maven capture:@\n%s %s@." prog
(String.concat ~sep:" " (List.map ~f:(Printf.sprintf "'%s'") capture_args));
(* let children infer processes know that they are spawned by Maven *)
Unix.fork_exec ~prog ~args:(prog::capture_args) ~env:Config.env_inside_maven ()
Unix.fork_exec ~prog ~argv:(prog::capture_args) ~env:Config.env_inside_maven ()
|> Unix.waitpid
|> function
| Ok () -> ()

@ -99,13 +99,13 @@ type t = string * file_entry String.Map.t * JBasics.ClassSet.t
Only the case where the package is declared in a single line is supported *)
let read_package_declaration source_file =
let path = SourceFile.to_abs_path source_file in
let file_in = open_in path in
let file_in = In_channel.create path in
let remove_trailing_semicolon =
Str.replace_first (Str.regexp ";") "" in
let empty_package = "" in
let rec loop () =
try
let line = remove_trailing_semicolon (input_line file_in) in
let line = remove_trailing_semicolon (In_channel.input_line_exn file_in) in
match Str.split (Str.regexp "[ \t]+") line with
| [] -> loop ()
| hd::package::[] when String.equal hd "package" -> package
@ -153,7 +153,7 @@ let add_root_path path roots =
let load_from_verbose_output javac_verbose_out =
let file_in = open_in javac_verbose_out in
let file_in = In_channel.create javac_verbose_out in
let class_filename_re =
Str.regexp
"\\[wrote RegularFileObject\\[\\(.*\\)\\]\\]" in
@ -165,7 +165,7 @@ let load_from_verbose_output javac_verbose_out =
"\\[search path for class files: \\(.*\\)\\]" in
let rec loop paths roots sources classes =
try
let line = input_line file_in in
let line = In_channel.input_line_exn file_in in
if Str.string_match class_filename_re line 0 then
let path = Str.matched_group 1 line in
let cn, root_info = Javalib.extract_class_name_from_file path in

@ -126,8 +126,8 @@ let cache_classname cn =
| [] -> ()
| d:: tl -> mkdir tl (Filename.concat p d) in
mkdir splitted_root_dir Filename.dir_sep;
let file_out = open_out(path) in
output_string file_out (string_of_float (Unix.time ()));
let file_out = Out_channel.create path in
Out_channel.output_string file_out (string_of_float (Unix.time ()));
Out_channel.close file_out
let is_classname_cached cn =

@ -29,7 +29,7 @@ depends: [
"ANSITerminal" {>="0.7"}
"atdgen" {>="1.6.0"}
"cmdliner" {>="1.0.0"}
"core" {<"v0.9"}
"core"
"conf-autoconf"
"ctypes" {>="0.9.2"}
"extlib-compat"

@ -1,71 +1,90 @@
ANSITerminal = 0.7
atd = 1.2.0
atdgen = 1.10.0
bin_prot = 113.33.00+4.03
biniou = 1.0.12
atd = 1.12.0
atdgen = 1.12.0
base = v0.9.3
bin_prot = v0.9.0
biniou = 1.0.13
camlp4 = 4.04+1
camlzip = 1.07
camomile = 0.8.5
cmdliner = 1.0.0
conf-aclocal = 1.0.0
conf-autoconf = 0.1
conf-m4 = 1
conf-pkg-config = 1.0
conf-which = 1
core = 113.33.02+4.03
core_kernel = 113.33.02+4.03
cppo = 1.4.1
ctypes = 0.11.3
configurator = v0.9.1
core = v0.9.1
core_kernel = v0.9.0
cppo = 1.5.0
ctypes = 0.12.0
easy-format = 1.2.0
extlib-compat = 1.7.0
fieldslib = 113.24.00
fieldslib = v0.9.0
integers = 0.2.2
jane-street-headers = v0.9.0
javalib = 2.3.3
jbuilder = 1.0+beta6
lambda-term = 1.10.1
lwt = 2.7.1
jbuilder = 1.0+beta10
lambda-term = 1.11
lwt = 3.0.0
lwt_react = 1.0.1
menhir = 20170101
merlin-extend = 0.3
ocaml-migrate-parsetree = 0.7
num = 0
ocaml-compiler-libs = v0.9.0
ocaml-migrate-parsetree = 1.0.1
ocamlbuild = 0.11.0
ocamlfind = 1.7.1
ocamlfind = 1.7.3
octavius = 1.1.0
ounit = 2.0.0
parmap = 1.0-rc8
ppx_assert = 113.33.00
ppx_bench = 113.33.00+4.03
ppx_bin_prot = 113.33.00+4.03
ppx_compare = 113.33.00+4.03
ppx_core = 113.33.01+4.03
ppx_custom_printf = 113.33.00+4.03
ppx_assert = v0.9.0
ppx_ast = v0.9.1
ppx_base = v0.9.0
ppx_bench = v0.9.1
ppx_bin_prot = v0.9.0
ppx_compare = v0.9.0
ppx_core = v0.9.0
ppx_custom_printf = v0.9.0
ppx_deriving = 4.1
ppx_driver = 113.33.02+4.03
ppx_enumerate = 113.33.00+4.03
ppx_expect = 113.33.01+4.03
ppx_fail = 113.33.00+4.03
ppx_fields_conv = 113.33.00+4.03
ppx_here = 113.33.00
ppx_inline_test = 113.33.00+4.03
ppx_jane = 113.33.00
ppx_let = 113.33.00+4.03
ppx_optcomp = 113.33.01+4.03
ppx_pipebang = 113.33.00+4.03
ppx_sexp_conv = 113.33.01+4.03
ppx_sexp_message = 113.33.00+4.03
ppx_sexp_value = 113.33.00+4.03
ppx_driver = v0.9.1
ppx_enumerate = v0.9.0
ppx_expect = v0.9.0
ppx_fail = v0.9.0
ppx_fields_conv = v0.9.0
ppx_hash = v0.9.0
ppx_here = v0.9.1
ppx_inline_test = v0.9.1
ppx_jane = v0.9.0
ppx_js_style = v0.9.0
ppx_let = v0.9.0
ppx_metaquot = v0.9.0
ppx_optcomp = v0.9.0
ppx_optional = v0.9.0
ppx_pipebang = v0.9.0
ppx_sexp_conv = v0.9.0
ppx_sexp_message = v0.9.0
ppx_sexp_value = v0.9.0
ppx_tools = 5.0
ppx_tools_versioned = 5.0alpha
ppx_type_conv = 113.33.02+4.03
ppx_typerep_conv = 113.33.00+4.03
ppx_variants_conv = 113.33.00+4.03
ppx_traverse = v0.9.0
ppx_traverse_builtins = v0.9.0
ppx_type_conv = v0.9.0
ppx_typerep_conv = v0.9.0
ppx_variants_conv = v0.9.0
re = 1.7.1
react = 1.2.0
reason = 1.13.4
reason-parser = 1.13.4
result = 1.2
sawja = 1.5.2
sexplib = 113.33.00+4.03
sexplib = v0.9.1
spawn = v0.9.0
stdio = v0.9.0
topkg = 0.8.1
typerep = 113.24.00
typerep = v0.9.0
utop = 1.19.3
variantslib = 113.24.00
variantslib = v0.9.0
xmlm = 1.2.0
yojson = 1.3.3
zed = 1.4
zed = 1.5

Loading…
Cancel
Save