Skip to content

Commit

Permalink
Use mtime + inode to detect when we need to rehash
Browse files Browse the repository at this point in the history
Previously we were only using mtime but it's not precise on OSX.
  • Loading branch information
Jeremie Dimino committed Jan 29, 2018
1 parent a5a0c4c commit 0aaf85c
Show file tree
Hide file tree
Showing 2 changed files with 59 additions and 28 deletions.
85 changes: 58 additions & 27 deletions src/utils.ml
Original file line number Diff line number Diff line change
Expand Up @@ -164,42 +164,63 @@ let install_file ~package ~findlib_toolchain =
| Some x -> sprintf "%s-%s.install" package x

module Cached_digest = struct
module Stats = struct
(* Subset of [Unix.stat].
The intent is to have the smallest structure such that if the file contents
changes, this structure changes as well. *)
type t =
{ inode : int
; mtime : float
}

let of_file fn =
let st = Unix.stat (Path.to_string fn) in
{ inode = st.st_ino
; mtime = st.st_mtime
}

let equal t { inode; mtime } =
t.inode = inode &&
t.mtime = mtime
end

type file =
{ mutable digest : Digest.t
; mutable timestamp : float
; mutable timestamp_checked : bool
{ mutable digest : Digest.t
; mutable stats : Stats.t
; mutable stats_checked : bool
}

let cache = Hashtbl.create 1024

let file fn =
match Hashtbl.find cache fn with
| Some x ->
if x.timestamp_checked then
if x.stats_checked then
x.digest
else begin
let mtime = (Unix.stat (Path.to_string fn)).st_mtime in
if mtime <> x.timestamp then begin
let stats = Stats.of_file fn in
if not (Stats.equal stats x.stats) then begin
let digest = Digest.file (Path.to_string fn) in
x.digest <- digest;
x.timestamp <- mtime;
x.digest <- digest;
x.stats <- stats;
end;
x.timestamp_checked <- true;
x.stats_checked <- true;
x.digest
end
| None ->
let digest = Digest.file (Path.to_string fn) in
Hashtbl.add cache ~key:fn
~data:{ digest
; timestamp = (Unix.stat (Path.to_string fn)).st_mtime
; timestamp_checked = true
; stats = Stats.of_file fn
; stats_checked = true
};
digest

let remove fn =
match Hashtbl.find cache fn with
| None -> ()
| Some file -> file.timestamp_checked <- false
| Some file -> file.stats_checked <- false

let db_file = "_build/.digest-db"

Expand All @@ -211,9 +232,11 @@ module Cached_digest = struct
Pmap.add acc ~key ~data)
|> Path.Map.bindings
|> List.map ~f:(fun (path, file) ->
let { digest; stats = { inode; mtime }; stats_checked = _ } = file in
Sexp.List [ Atom (Path.to_string path)
; Atom (Digest.to_hex file.digest)
; Atom (Int64.to_string (Int64.bits_of_float file.timestamp))
; Atom (Digest.to_hex digest)
; Atom (string_of_int inode)
; Atom (Int64.to_string (Int64.bits_of_float mtime))
]))
in
if Sys.file_exists "_build" then
Expand All @@ -222,20 +245,28 @@ module Cached_digest = struct
let load () =
if Sys.file_exists db_file then begin
let sexp = Sexp.load ~fname:db_file ~mode:Single in
let bindings =
let rec binding (sexp : Sexp.Ast.t) =
let open Sexp.Of_sexp in
list
(triple
Path.t
(fun s -> Digest.from_hex (string s))
(fun s -> Int64.float_of_bits (Int64.of_string (string s)))
) sexp
match sexp with
| List (_, [path; digest; inode; mtime]) ->
let path = Path.t path in
let file =
{ digest = Digest.from_hex (string digest)
; stats = { inode = int inode
; mtime = Int64.float_of_bits
(Int64.of_string (string mtime))
}
; stats_checked = false
}
in
Hashtbl.add cache ~key:path ~data:file
| List (loc, [path; digest; mtime]) ->
binding (List (loc, [path; digest; Atom (loc, "0"); mtime]))
| _ ->
of_sexp_error sexp "S-expression of the form (_ _ _ _) expected"
in
List.iter bindings ~f:(fun (path, digest, timestamp) ->
Hashtbl.add cache ~key:path
~data:{ digest
; timestamp
; timestamp_checked = false
});
match sexp with
| Atom _ -> Sexp.Of_sexp.of_sexp_error sexp "list expected"
| List (_, l) -> List.iter l ~f:binding
end
end
2 changes: 1 addition & 1 deletion test/blackbox-tests/test-cases/promote/run.t
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
$ echo titi > x
$ printf titi > x

$ $JBUILDER build --root . -j1 --diff-command false @blah 2>&1 | sed 's/.*false.*/DIFF/'
sh (internal) (exit 1)
Expand Down

0 comments on commit 0aaf85c

Please sign in to comment.