matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge pull request #466 from rgrinberg/lib_db-check-dir 

Verify that scope by path lookup uses valid dirs
This commit is contained in:
Rudi Grinberg 2018-01-31 20:59:22 +08:00 committed by GitHub
parent 51b9164ff1 3bf3c91105
commit 00623728e1
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 14 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/lib_db.ml
View File

@ -20,15 +20,20 @@ type t =
; by_scope_name : (string, scope) Hashtbl.t
}
let rec internal_name_scope t ~dir =
match Hashtbl.find t.by_internal_name dir with
| Some scope -> scope
| None ->
(* [create] ensures that [Hashtbl.find t.by_internal_name Path.root] is [Some _] so
this [Path.parent dir] is never called with [Path.root] *)
let scope = internal_name_scope t ~dir:(Path.parent dir) in
Hashtbl.add t.by_internal_name ~key:dir ~data:scope;
scope
let internal_name_scope t ~dir =
let rec loop d =
match Hashtbl.find t.by_internal_name d with
| Some scope -> scope
| None ->
if Path.is_root d || not (Path.is_local d) then (
Sexp.code_error "Lib_db.Scope.internal_name_scope got an invalid path"
[ "dir", Path.sexp_of_t dir
; "t.anonymous_root", Path.sexp_of_t t.anonymous_root ]
);
let scope = loop (Path.parent d) in
Hashtbl.add t.by_internal_name ~key:d ~data:scope;
scope in
loop dir
type 'a with_required_by =
{ required_by: string list