summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2004-01-13 14:11:04 +0000
committerPascal Rigaux <pixel@mandriva.com>2004-01-13 14:11:04 +0000
commit0534eb2c7cf65db5d0e07e03b14d361f04df3e09 (patch)
treef362a979c0ce9f07d8b4719863905a85cb137c08
parentb3e55b9596ad46d0411bae54194beeaa32aab585 (diff)
downloadperl-MDK-Common-0534eb2c7cf65db5d0e07e03b14d361f04df3e09.tar
perl-MDK-Common-0534eb2c7cf65db5d0e07e03b14d361f04df3e09.tar.gz
perl-MDK-Common-0534eb2c7cf65db5d0e07e03b14d361f04df3e09.tar.bz2
perl-MDK-Common-0534eb2c7cf65db5d0e07e03b14d361f04df3e09.tar.xz
perl-MDK-Common-0534eb2c7cf65db5d0e07e03b14d361f04df3e09.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.ml2
-rw-r--r--perl_checker.src/common.mli2
-rw-r--r--perl_checker.src/global_checks.ml11
-rw-r--r--perl_checker.src/perl_checker.ml4
-rw-r--r--perl_checker.src/tree.ml2
-rw-r--r--perl_checker.src/tree.mli4
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