diff options
| author | Pascal Rigaux <pixel@mandriva.com> | 2004-01-13 14:11:04 +0000 | 
|---|---|---|
| committer | Pascal Rigaux <pixel@mandriva.com> | 2004-01-13 14:11:04 +0000 | 
| commit | be8db69c2cb1b184265803ff6efb7be5e946a474 (patch) | |
| tree | d4a4dc94e4db5e6747075aef2d9a59b6dd3a5d31 | |
| parent | 4eb762f8af4f23b0ff940f2e5760d5d58756d33f (diff) | |
| download | perl_checker-be8db69c2cb1b184265803ff6efb7be5e946a474.tar perl_checker-be8db69c2cb1b184265803ff6efb7be5e946a474.tar.gz perl_checker-be8db69c2cb1b184265803ff6efb7be5e946a474.tar.bz2 perl_checker-be8db69c2cb1b184265803ff6efb7be5e946a474.tar.xz perl_checker-be8db69c2cb1b184265803ff6efb7be5e946a474.zip | |
use a float to save the mtime since int overflows.
this fixes the cache being used partially
| -rw-r--r-- | perl_checker.src/common.ml | 2 | ||||
| -rw-r--r-- | perl_checker.src/common.mli | 2 | ||||
| -rw-r--r-- | perl_checker.src/global_checks.ml | 11 | ||||
| -rw-r--r-- | perl_checker.src/perl_checker.ml | 4 | ||||
| -rw-r--r-- | perl_checker.src/tree.ml | 2 | ||||
| -rw-r--r-- | perl_checker.src/tree.mli | 4 | 
6 files changed, 15 insertions, 10 deletions
| diff --git a/perl_checker.src/common.ml b/perl_checker.src/common.ml index ddd6b08..6a3be82 100644 --- a/perl_checker.src/common.ml +++ b/perl_checker.src/common.ml @@ -859,7 +859,7 @@ let expand_symlinks file =          ) (file ^ "/" ^ piece)) "" l    | _ -> internal_error (Printf.sprintf "expand_symlinks: %s is relative\n" file) -let mtime f = int_of_float ((Unix.stat f).Unix.st_mtime) +let mtime f = (Unix.stat f).Unix.st_mtime  let rec updir dir nb =    if nb = 0 then dir else diff --git a/perl_checker.src/common.mli b/perl_checker.src/common.mli index 276faca..df09b47 100644 --- a/perl_checker.src/common.mli +++ b/perl_checker.src/common.mli @@ -215,7 +215,7 @@ val words : string -> string list  val to_CamelCase : string -> string option  val concat_symlink : string -> string -> string  val expand_symlinks : string -> string -val mtime : string -> int +val mtime : string -> float  val updir : string -> int -> string  val string_of_ref : 'a ref -> string  val print_endline_flush_quiet : bool ref diff --git a/perl_checker.src/global_checks.ml b/perl_checker.src/global_checks.ml index 6dfe2ba..6160590 100644 --- a/perl_checker.src/global_checks.ml +++ b/perl_checker.src/global_checks.ml @@ -535,6 +535,10 @@ let default_state per_files = { per_files = per_files; per_packages = Hashtbl.cr  let cache_cache = Hashtbl.create 16 +let pkgs2s prefix l = +  let l = List.sort compare (List.map (fun pkg -> pkg.file_name) l) in +  String.concat "" (List.map (fun s -> prefix ^ s ^ "\n") l) +  let read_packages_from_cache per_files dir =    if !Flags.no_cache || Hashtbl.mem cache_cache dir then () else    try @@ -551,7 +555,7 @@ let read_packages_from_cache per_files dir =        (try file.build_time > mtime file.file_name with _ -> false)      ) l in -    if !Flags.verbose then print_endline_flush (sprintf "using cached files\n%sfrom %s" (String.concat "" (List.map (fun s -> "   " ^ s ^ "\n") (List.sort compare (List.map (fun pkg -> pkg.file_name) l)))) file) ; +    if !Flags.verbose then print_endline_flush (sprintf "using cached files\n%sfrom %s" (pkgs2s "   " l) file) ;      List.iter (fun file ->         Info.add_a_file file.file_name file.lines_starts ; @@ -561,10 +565,11 @@ let read_packages_from_cache per_files dir =  let write_packages_cache per_files dir =    try +    let l = List.filter (fun per_file -> per_file.require_name <> None) (hashtbl_values per_files) in      let file = dir ^ "/.perl_checker.cache" in      let fh = open_out file in      output_string fh ("perl_checker cache " ^ string_of_int Build.date ^ "\n") ; -    Marshal.to_channel fh (List.filter (fun per_file -> per_file.require_name <> None) (hashtbl_values per_files)) [] ; +    Marshal.to_channel fh l [] ;      close_out fh ; -    if !Flags.verbose then print_endline_flush ("saving cached packages in " ^ file) +    if !Flags.verbose then print_endline_flush (sprintf "saving cached files\n%sin %s" (pkgs2s "   " l) file)    with Sys_error _ -> () diff --git a/perl_checker.src/perl_checker.ml b/perl_checker.src/perl_checker.ml index 8e9bbd9..ee4748a 100644 --- a/perl_checker.src/perl_checker.ml +++ b/perl_checker.src/perl_checker.ml @@ -23,7 +23,7 @@ let set_basedir per_files file =  let rec parse_file from_basedir require_name per_files file =    try      if !Flags.verbose then print_endline_flush_always ("parsing " ^ file) ; -    let build_time = int_of_float (Unix.time()) in +    let build_time = Unix.time() in      let command =         match !Flags.expand_tabs with        | Some width -> "expand -t " ^ string_of_int width @@ -102,7 +102,7 @@ let parse_options =    let usage = "Usage: perl_checker [-v] [-q] <files>\nOptions are:" in    Arg.parse options (lpush args_r) usage; -  let files = if !args_r = [] && Build.debugging then ["../t.pl"] else !args_r in +  let files = if !args_r = [] && Build.debugging then ["/home/pixel/cooker/gi/perl-install/wizards.pm"] else !args_r in    let files = List.map Info.file_to_absolute_file files in    let required_packages, per_files = collect_withenv (parse_file true None) (default_per_files()) files in diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml index 335934b..23f1467 100644 --- a/perl_checker.src/tree.ml +++ b/perl_checker.src/tree.ml @@ -35,7 +35,7 @@ type per_file = {      file_name : string ;      require_name : string option ;      lines_starts : int list ; -    build_time : int ; +    build_time : float ;      packages : per_package list ;      from_basedir : bool ;    } diff --git a/perl_checker.src/tree.mli b/perl_checker.src/tree.mli index 9363a5e..b8615f5 100644 --- a/perl_checker.src/tree.mli +++ b/perl_checker.src/tree.mli @@ -32,7 +32,7 @@ type per_file = {      file_name : string ;      require_name : string option ;      lines_starts : int list ; -    build_time : int ; +    build_time : float ;      packages : per_package list ;      from_basedir : bool ;    } @@ -43,7 +43,7 @@ val use_lib : string list ref  val uses_external_package : string -> bool  val findfile : string list -> string -> string -val get_global_info_from_package : bool -> string option -> int -> fromparser list -> per_file +val get_global_info_from_package : bool -> string option -> float -> fromparser list -> per_file  val has_proto : string option -> fromparser -> ((context * string) list * pos * fromparser list) option  val get_vars_declaration : (context * string * string, pos * prototype option) Hashtbl.t -> string -> per_package -> unit | 
