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_ASSERT_PROG([ocamllex], [$OCAMLLEX])
AC_PATH_TOOL([MENHIR], [menhir], [no]) AC_PATH_TOOL([MENHIR], [menhir], [no])
AC_ASSERT_PROG([menhir], [$MENHIR]) 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([biniou])
AC_ASSERT_OCAML_PKG([camlzip], [zip]) AC_ASSERT_OCAML_PKG([camlzip], [zip])
AC_ASSERT_OCAML_PKG([easy-format]) 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 save_call_graph_dotty source (g: t) => {
let fname_dot = let fname_dot =
DB.Results_dir.path_to_filename (DB.Results_dir.Abs_source_dir source) ["call_graph.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; let fmt = F.formatter_of_out_channel outc;
pp_graph_dotty g fmt; pp_graph_dotty g fmt;
Out_channel.close outc 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; Serialization.write_to_file tenv_serializer filename data::tenv;
if Config.debug_mode { if Config.debug_mode {
let debug_filename = DB.filename_to_string (DB.filename_add_suffix filename ".debug"); 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; let fmt = Format.formatter_of_out_channel out_channel;
Format.fprintf fmt "%a" pp tenv; Format.fprintf fmt "%a" pp tenv;
Out_channel.close out_channel Out_channel.close out_channel

@ -77,7 +77,7 @@ let output_json_makefile_stats clusters => {
let file_stats = let file_stats =
`Assoc [("files", `Int num_files), ("procedures", `Int num_procs), ("lines", `Int num_lines)]; `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 */ /* 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 Yojson.Basic.pretty_to_channel f file_stats
}; };

@ -136,7 +136,7 @@ let iterate_callbacks call_graph exe_env =
| Some pdesc -> Some pdesc | Some pdesc -> Some pdesc
| None when Config.dynamic_dispatch = `Lazy -> | None when Config.dynamic_dispatch = `Lazy ->
Option.bind (Specs.get_summary proc_name) 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 | None -> None in
let callbacks = { let callbacks = {

@ -43,7 +43,7 @@ let pp_epilog fmt () =
F.fprintf fmt "@.clean:@.\trm -f $(CLUSTERS)@." F.fprintf fmt "@.clean:@.\trm -f $(CLUSTERS)@."
let create_cluster_makefile (clusters: Cluster.t list) (fname: string) = 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 fmt = Format.formatter_of_out_channel outc in
let do_cluster cluster_nr cluster = let do_cluster cluster_nr cluster =
F.fprintf fmt "#%s@\n" (DB.source_dir_to_string 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 *) (* create a dotty file with a single proposition *)
let dotty_prop_to_dotty_file fname prop cycle = let dotty_prop_to_dotty_file fname prop cycle =
try 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 let fmt_dot = Format.formatter_of_out_channel out_dot in
pp_dotty_prop fmt_dot (prop, cycle); pp_dotty_prop fmt_dot (prop, cycle);
Out_channel.close out_dot 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"; F.fprintf f "@\n /* size=\"12,7\"; ratio=fill;*/ @\n";
ignore (List.map ~f:(pp_dotty f Generic_proposition) plist); ignore (List.map ~f:(pp_dotty f Generic_proposition) plist);
F.fprintf f "@\n}" in 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 let fmt = F.formatter_of_out_channel outc in
F.fprintf fmt "#### Dotty version: ####@.%a@.@." pp_list plist; F.fprintf fmt "#### Dotty version: ####@.%a@.@." pp_list plist;
Out_channel.close outc Out_channel.close outc
@ -1080,7 +1080,7 @@ let print_icfg source fmt cfg =
Cfg.iter_all_nodes ~sorted:true print_node cfg Cfg.iter_all_nodes ~sorted:true print_node cfg
let write_icfg_dotty_to_file source cfg fname = 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 let fmt = Format.formatter_of_out_channel chan in
(* avoid phabricator thinking this file was generated by substituting substring with %s *) (* avoid phabricator thinking this file was generated by substituting substring with %s *)
F.fprintf fmt "/* %@%s */@\ndigraph iCFG {@\n" "generated"; 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_speclist_to_file (filename : DB.filename) spec_list =
let pp_simple_saved = !Config.pp_simple in let pp_simple_saved = !Config.pp_simple in
Config.pp_simple := true; 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 fmt = F.formatter_of_out_channel outc in
let () = F.fprintf fmt "#### Dotty version: ####@\n%a@\n@\n" (pp_speclist_dotty) spec_list in let () = F.fprintf fmt "#### Dotty version: ####@\n%a@\n@\n" (pp_speclist_dotty) spec_list in
Out_channel.close outc; 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_rv_dexp tenv seen node e1
| Exp.Sizeof {typ; dynamic_length; subtype} -> | Exp.Sizeof {typ; dynamic_length; subtype} ->
if verbose then (L.d_str "exp_rv_dexp: type "; Sil.d_exp e; L.d_ln ()); 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 ()); if verbose then (L.d_str "exp_rv_dexp: no match for "; Sil.d_exp e; L.d_ln ());
None None

@ -69,7 +69,7 @@ module FileContainsStringMatcher = struct
let file_contains regexp file_in = let file_contains regexp file_in =
let rec loop () = let rec loop () =
try 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 with
| Not_found -> loop () | Not_found -> loop ()
| End_of_file -> false in | End_of_file -> false in
@ -87,7 +87,7 @@ module FileContainsStringMatcher = struct
SourceFile.Map.find source_file !source_map SourceFile.Map.find source_file !source_map
with Not_found -> with Not_found ->
try 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 let pattern_found = file_contains regexp file_in in
In_channel.close file_in; In_channel.close file_in;
source_map := SourceFile.Map.add source_file pattern_found !source_map; 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 | Some pdesc -> Some pdesc
| None when Config.dynamic_dispatch = `Lazy -> | None when Config.dynamic_dispatch = `Lazy ->
Option.bind (Specs.get_summary proc_name) 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 | None -> None in
let analyze_ondemand _ proc_desc = let analyze_ondemand _ proc_desc =
let proc_name = Procdesc.get_proc_name proc_desc in 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 source_dir = DB.source_dir_from_source_file source in
let stats_file = DB.source_dir_get_internal_file source_dir ".stats" in let stats_file = DB.source_dir_get_internal_file source_dir ".stats" in
try 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 let fmt = F.formatter_of_out_channel outc in
print_file_stats fmt (); print_file_stats fmt ();
Out_channel.close outc Out_channel.close outc

@ -81,7 +81,7 @@ let add_multilink_attr ~stats src dst =
let create_link ~stats src dst = let create_link ~stats src dst =
if link_exists dst then Unix.unlink 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 (* 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 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 link to have the same modification time. When this happens, the files will be considered to

@ -27,11 +27,11 @@ struct
Hashtbl.create 1 Hashtbl.create 1
let read_file fname = let read_file fname =
let cin = open_in fname in let cin = In_channel.create fname in
let lines = ref [] in let lines = ref [] in
try try
while true do while true do
let line_raw = input_line cin in let line_raw = In_channel.input_line_exn cin in
let line = let line =
let len = String.length line_raw in let len = String.length line_raw in
if len > 0 && Char.equal (String.get line_raw (len -1)) '\013' then 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 if type_opt_is_unsigned t then add_lt_minus1_e e
| Sil.Estruct (fsel, _), t -> | Sil.Estruct (fsel, _), t ->
let get_field_type f = 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' Option.map ~f:fst @@ Typ.Struct.get_field_type_and_annotation ~lookup f t'
) in ) in
List.iter ~f:(fun (f, se) -> strexp_extract (se, get_field_type f)) fsel 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. *) We use this to distinguish among different queries. *)
let get_smt_key a p = let get_smt_key a p =
let tmp_filename = Filename.temp_file "smt_query" ".cns" in 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 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 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; Out_channel.close outc_tmp;
@ -759,7 +759,7 @@ let check_atom tenv prop a0 =
DB.Results_dir.path_to_filename DB.Results_dir.path_to_filename
(DB.Results_dir.Abs_source_dir source) (DB.Results_dir.Abs_source_dir source)
[(key ^ ".cns")] in [(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 let fmt = F.formatter_of_out_channel outc in
L.d_str ("ID: "^key); L.d_ln (); L.d_str ("ID: "^key); L.d_ln ();
L.d_str "CHECK_ATOM_BOUND: "; Sil.d_atom a; 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] [@@deriving compare]
(** Comparison for joined_prop *) (** 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 *) (** Return true if the two join_prop's are equal *)
let equal jp1 jp2 = let equal jp1 jp2 =

@ -661,7 +661,7 @@ let resolve_and_analyze
~f:(fun callee_proc_desc -> ~f:(fun callee_proc_desc ->
Cfg.specialize_types callee_proc_desc resolved_pname args) Cfg.specialize_types callee_proc_desc resolved_pname args)
(Ondemand.get_proc_desc callee_proc_name)) in (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 let resolved_pname = match callee_proc_name with
| Typ.Procname.Java callee_proc_name_java -> | Typ.Procname.Java callee_proc_name_java ->
Typ.Procname.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 (** 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. *) case of InferCommand, include [desc] in --help only for the relevant sections. *)
let add parse_mode sections desc = 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; desc_list := desc :: !desc_list;
let add_to_section (command, section) = let add_to_section (command, section) =
let sections = List.Assoc.find_exn ~equal:equal_command help_sections_desc_lists command in 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 -> | None ->
default_doc default_doc
| Some command -> | Some command ->
match List.Assoc.find_exn !subcommands command with match List.Assoc.find_exn ~equal:equal_command !subcommands command with
| (Some command_doc, _, _) -> | (Some command_doc, _, _) ->
command_doc command_doc
| (None, _, _) -> | (None, _, _) ->
@ -885,7 +885,7 @@ let show_manual ?internal_section format default_doc command_opt =
[] in [] in
match command_opt with match command_opt with
| Some command -> | 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 -> SectionMap.fold (fun section descs result ->
`S section :: `S section ::
(if String.equal section Cmdliner.Manpage.s_options then blocks else []) @ (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 dot_crc_len = 1 + 32
let strip_crc str = 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 string_crc_has_extension ~ext name_crc =
let name = strip_crc name_crc in 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. * of patent rights can be found in the PATENTS file in the same directory.
*) *)
include Core.Std include Core
module Unix_ = struct module Unix_ = struct
@ -40,10 +40,6 @@ module Unix_ = struct
Unix.waitpid (create_process_redirect ~prog ~args ?stdin ?stdout ?stderr ()) Unix.waitpid (create_process_redirect ~prog ~args ?stdin ?stdout ?stderr ())
|> Unix.Exit_or_signal.or_error |> ok_exn |> 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 end
module List_ = struct module List_ = struct

@ -271,7 +271,7 @@ let setup_log_file () =
let fmt, chan, preexisting_logfile = let fmt, chan, preexisting_logfile =
if Config.buck_cache_mode then if Config.buck_cache_mode then
(* suppress log file in order not to cause flakiness in the Buck cache *) (* 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 let devnull_fmt = F.formatter_of_out_channel devnull_chan in
devnull_fmt, devnull_chan, true devnull_fmt, devnull_chan, true
else else

@ -45,8 +45,9 @@ let read ::dir :option t => {
/* Write a multilink file in the given directory */ /* Write a multilink file in the given directory */
let write multilinks ::dir => { let write multilinks ::dir => {
let fname = Filename.concat dir multilink_file_name; let fname = Filename.concat dir multilink_file_name;
let outc = open_out fname; let outc = Out_channel.create fname;
String.Table.iteri f::(fun key::_ data::src => output_string outc (src ^ "\n")) multilinks; String.Table.iteri
f::(fun key::_ data::src => Out_channel.output_string outc (src ^ "\n")) multilinks;
Out_channel.close outc 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, terminate. The standard out and error are not redirected. If the command fails to execute,
print an error message and exit. *) print an error message and exit. *)
let create_process_and_wait ~prog ~args = let create_process_and_wait ~prog ~args =
Unix.fork_exec ~prog ~args:(prog :: args) () Unix.fork_exec ~prog ~argv:(prog :: args) ()
|> Unix.waitpid |> Unix.waitpid
|> function |> function
| Ok () -> () | 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 match Unix.fork () with
| `In_the_child -> | `In_the_child ->
Option.iter dir_opt ~f:Unix.chdir ; 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 |> Unix.handle_unix_error
|> never_returns |> never_returns
| `In_the_parent pid_child -> | `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_out ;
Unix.close pipe_in ; Unix.close pipe_in ;
(* exec producer *) (* 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 -> | `In_the_parent producer_pid ->
match Unix.fork () with match Unix.fork () with
| `In_the_child -> | `In_the_child ->
@ -118,7 +118,7 @@ let pipeline ~producer_prog ~producer_args ~consumer_prog ~consumer_args =
Unix.close pipe_out ; Unix.close pipe_out ;
Unix.close pipe_in ; Unix.close pipe_in ;
(* exec consumer *) (* 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 -> | `In_the_parent consumer_pid ->
(* close parent's copy of pipe ends *) (* close parent's copy of pipe ends *)
Unix.close pipe_out ; Unix.close pipe_out ;

@ -77,7 +77,7 @@ let create_serializer (key : Key.t) : 'a serializer =
The writes are synchronized with a .lock file. *) The writes are synchronized with a .lock file. *)
let read_from_file (fname : DB.filename) : 'a option = let read_from_file (fname : DB.filename) : 'a option =
let fname_str = DB.filename_to_string fname in 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 _ -> | exception Sys_error _ ->
None None
| inc -> | inc ->

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

@ -34,7 +34,7 @@ val filename_to_relative : root:string -> string -> string option
(** type for files used for printing *) (** type for files used for printing *)
type outfile = type outfile =
{ fname : string; (** name of the file *) { 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 *) } fmt : Format.formatter (** formatter for printing *) }
(** create an outfile for the command line, the boolean indicates whether to do demangling when closing the file *) (** 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 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 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 (** Lock file passed as argument and write into it using [f]. If [delete] then the file is unlinked
once this is done. *) 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 *) (** [rmtree path] removes [path] and, if [path] is a directory, recursively removes its contents *)
val rmtree : string -> unit val rmtree : string -> unit

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

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

@ -136,7 +136,7 @@ let run_plugin_and_frontend source_path frontend clang_args => {
let basename = source_path ^ ".ast"; let basename = source_path ^ ".ast";
/* Emit the clang command with the extra args piped to infer-as-clang */ /* Emit the clang command with the extra args piped to infer-as-clang */
let frontend_script_fname = Printf.sprintf "%s.sh" basename; 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 debug_script_fmt = Format.formatter_of_out_channel debug_script_out;
let biniou_fname = Printf.sprintf "%s.biniou" basename; let biniou_fname = Printf.sprintf "%s.biniou" basename;
Format.fprintf debug_script_fmt "%s \\@\n > %s@\n" clang_command biniou_fname; 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 => let consume_input i =>
try ( try (
while true { while true {
let line = input_line i; let line = In_channel.input_line_exn i;
/* keep only commands and errors */ /* keep only commands and errors */
if (Str.string_match commands_or_errors line 0) { if (Str.string_match commands_or_errors line 0) {
normalized_commands := [one_line line, ...!normalized_commands] 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 already_imported_files = ref []
let rec parse_import_file import_file channel = 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.") failwith ("Cyclic imports: file '" ^ import_file ^ "' was already imported.")
else ( else (
match parse_al_file import_file channel with 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 = and parse_imports imports_files =
let parse_one_import_file fimport (macros, paths) = let parse_one_import_file fimport (macros, paths) =
L.(debug Linters Medium) " Loading import macros from file %s@\n" fimport; 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 let parsed_macros, parsed_paths = parse_import_file fimport in_channel in
In_channel.close in_channel; In_channel.close in_channel;
let macros = List.append parsed_macros macros in 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 parse_ctl_files linters_def_files : CFrontend_errors.linter list =
let collect_parsed_linters linters_def_file linters = let collect_parsed_linters linters_def_file linters =
L.(debug Linters Medium) "Loading linters rules from %s@\n" linters_def_file; 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 let parsed_linters = parse_ctl_file linters_def_file in_channel in
In_channel.close in_channel; In_channel.close in_channel;
List.append parsed_linters linters in 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_constexpr = var_decl_info.Clang_ast_t.vdi_is_const_expr in
let is_pod = let is_pod =
CAst_utils.get_desugared_type qt.Clang_ast_t.qt_type_ptr 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 | Clang_ast_t.RecordType(_, decl_ptr) -> CAst_utils.get_decl decl_ptr
| _ -> None) | _ -> None)
|> Option.value_map ~default:true ~f:(function |> Option.value_map ~default:true ~f:(function

@ -305,7 +305,7 @@ module Debug = struct
L.progress "%s@\n" ast_str; L.progress "%s@\n" ast_str;
let quit_token = "q" in let quit_token = "q" in
L.progress "Press Enter to continue or type %s to quit... @?" quit_token; 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 | s when String.equal s quit_token -> exit 0
| _ -> | _ ->
(* Remove the line at the bottom of terminal with the debug instructions *) (* 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 source_file_basename = Filename.basename (SourceFile.to_abs_path source_file) in
let file = dotty_dir ^/ (source_file_basename ^ ".dot") in let file = dotty_dir ^/ (source_file_basename ^ ".dot") in
let dotty = Debug.EvaluationTracker.DottyPrinter.dotty_of_ctl_evaluation tracker 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 *) (* Helper functions *)

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

@ -287,7 +287,7 @@ let rec typ_string_of_type_ptr type_ptr =
let open Clang_ast_t in let open Clang_ast_t in
match CAst_utils.get_type type_ptr with match CAst_utils.get_type type_ptr with
| Some BuiltinType (_, bt) -> | 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 | Some abt -> builtin_kind_to_string abt
| None -> "") | None -> "")
| Some PointerType (_, qt) | Some PointerType (_, qt)

@ -53,7 +53,7 @@ type 'a t =
} [@@deriving compare] } [@@deriving compare]
(* Ignore the extension field, which is a pure instrumentation *) (* 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 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 new_path = Config.wrappers_dir ^ ":" ^ (Sys.getenv_exn path_var) in
let extended_env = `Extend [path_var, new_path] 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; 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 |> Unix.waitpid
|> function |> function
| Ok () -> () | Ok () -> ()

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

@ -44,7 +44,7 @@ let decode_json_file (database : t) json_format =
| `Raw _ -> | `Raw _ ->
s s
| `Escaped _ -> | `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 |> fst in
L.(debug Capture Quiet) "parsing compilation database from %s@\n" json_path; L.(debug Capture Quiet) "parsing compilation database from %s@\n" json_path;
let exit_format_error () = let exit_format_error () =

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

@ -152,7 +152,7 @@ let capture ~prog ~args =
L.(debug Capture Quiet) "Running maven capture:@\n%s %s@." prog L.(debug Capture Quiet) "Running maven capture:@\n%s %s@." prog
(String.concat ~sep:" " (List.map ~f:(Printf.sprintf "'%s'") capture_args)); (String.concat ~sep:" " (List.map ~f:(Printf.sprintf "'%s'") capture_args));
(* let children infer processes know that they are spawned by Maven *) (* 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 |> Unix.waitpid
|> function |> function
| Ok () -> () | 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 *) Only the case where the package is declared in a single line is supported *)
let read_package_declaration source_file = let read_package_declaration source_file =
let path = SourceFile.to_abs_path source_file in 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 = let remove_trailing_semicolon =
Str.replace_first (Str.regexp ";") "" in Str.replace_first (Str.regexp ";") "" in
let empty_package = "" in let empty_package = "" in
let rec loop () = let rec loop () =
try 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 match Str.split (Str.regexp "[ \t]+") line with
| [] -> loop () | [] -> loop ()
| hd::package::[] when String.equal hd "package" -> package | 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 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 = let class_filename_re =
Str.regexp Str.regexp
"\\[wrote RegularFileObject\\[\\(.*\\)\\]\\]" in "\\[wrote RegularFileObject\\[\\(.*\\)\\]\\]" in
@ -165,7 +165,7 @@ let load_from_verbose_output javac_verbose_out =
"\\[search path for class files: \\(.*\\)\\]" in "\\[search path for class files: \\(.*\\)\\]" in
let rec loop paths roots sources classes = let rec loop paths roots sources classes =
try 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 if Str.string_match class_filename_re line 0 then
let path = Str.matched_group 1 line in let path = Str.matched_group 1 line in
let cn, root_info = Javalib.extract_class_name_from_file path 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 | d:: tl -> mkdir tl (Filename.concat p d) in
mkdir splitted_root_dir Filename.dir_sep; mkdir splitted_root_dir Filename.dir_sep;
let file_out = open_out(path) in let file_out = Out_channel.create path in
output_string file_out (string_of_float (Unix.time ())); Out_channel.output_string file_out (string_of_float (Unix.time ()));
Out_channel.close file_out Out_channel.close file_out
let is_classname_cached cn = let is_classname_cached cn =

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

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

Loading…
Cancel
Save