aboutsummaryrefslogtreecommitdiffhomepage
path: root/lib/system.ml
diff options
context:
space:
mode:
authorGravatar Hugo Herbelin <Hugo.Herbelin@inria.fr>2015-09-22 09:05:44 +0200
committerGravatar Hugo Herbelin <Hugo.Herbelin@inria.fr>2015-11-25 18:06:09 +0100
commit3940441dffdfc3a8f968760c249f6a2e8a1e0912 (patch)
tree59a05c937688147fd12c7334d82ed291a21266a1 /lib/system.ml
parentef8718a7fd3bcd960d954093d8c636525e6cc492 (diff)
Generalizing the patch to bug #2554 on fixing path looking with
correct case on MacOS X whose file system is case-insensitive but case-preserving (HFS+ configured in case-insensitive mode). Generalized it to any case-preserving case-insensitive file system, which makes it applicable to Windows with NTFS used in case-insensitive mode but also to Linux when mounting a case-insensitive file system. Removed the blow-up of the patch, improved the core of the patch by checking whether the case is correct only for the suffix part of the file to be found (not for the part which corresponds to the path in which where to look), and finally used a cache so that the effect of the patch is not observable. Note that the cache is implemented in a way not synchronous with backtracking what implies e.g. that a file compiled in the middle of an interactive session would not be found until Coq is restarted, even by backtracking before the corresponding Require. For history see commits b712864e9cf499f1298c1aca1ad8a8b17e145079, 4b5af0d6e9ec1343a2c3ff9f856a019fa93c3606 69941d4e195650bf59285b897c14d6287defea0f e7043eec55085f4101bfb126d8829de6f6086c5a. as well as https://coq.inria.fr/bugs/show_bug.cgi?id=2554 discussion on coq-club "8.5 and MathClasses" (May 2015) discussion on coqdev "Coq awfully slow on MacOS X" (Sep 2015)
Diffstat (limited to 'lib/system.ml')
-rw-r--r--lib/system.ml50
1 files changed, 49 insertions, 1 deletions
diff --git a/lib/system.ml b/lib/system.ml
index ddc56956c..02d5e963f 100644
--- a/lib/system.ml
+++ b/lib/system.ml
@@ -53,6 +53,49 @@ let all_subdirs ~unix_path:root =
if exists_dir root then traverse root [];
List.rev !l
+(* Caching directory contents for efficient syntactic equality of file
+ names even on case-preserving but case-insensitive file systems *)
+
+module StrMod = struct
+ type t = string
+ let compare = compare
+end
+
+module StrMap = Map.Make(StrMod)
+module StrSet = Set.Make(StrMod)
+
+let dirmap = ref StrMap.empty
+
+let make_dir_table dir =
+ let b = ref StrSet.empty in
+ let a = Unix.opendir dir in
+ (try
+ while true do
+ let s = Unix.readdir a in
+ if s.[0] != '.' then b := StrSet.add s !b
+ done
+ with
+ | End_of_file -> ());
+ Unix.closedir a; !b
+
+let exists_in_dir_respecting_case dir bf =
+ let contents =
+ try StrMap.find dir !dirmap with Not_found ->
+ let contents = make_dir_table dir in
+ dirmap := StrMap.add dir contents !dirmap;
+ contents in
+ StrSet.mem bf contents
+
+let file_exists_respecting_case path f =
+ (* This function ensures that a file with expected lowercase/uppercase
+ is the correct one, even on case-insensitive file systems *)
+ let rec aux f =
+ let bf = Filename.basename f in
+ let df = Filename.dirname f in
+ (String.equal df "." || aux df)
+ && exists_in_dir_respecting_case (Filename.concat path df) bf
+ in Sys.file_exists (Filename.concat path f) && aux f
+
let rec search paths test =
match paths with
| [] -> []
@@ -77,7 +120,7 @@ let where_in_path ?(warn=true) path filename =
in
check_and_warn (search path (fun lpe ->
let f = Filename.concat lpe filename in
- if Sys.file_exists f then [lpe,f] else []))
+ if file_exists_respecting_case lpe filename then [lpe,f] else []))
let where_in_path_rex path rex =
search path (fun lpe ->
@@ -93,6 +136,8 @@ let where_in_path_rex path rex =
let find_file_in_path ?(warn=true) paths filename =
if not (Filename.is_implicit filename) then
+ (* the name is considered to be a physical name and we use the file
+ system rules (e.g. possible case-insensitivity) to find it *)
if Sys.file_exists filename then
let root = Filename.dirname filename in
root, filename
@@ -100,6 +145,9 @@ let find_file_in_path ?(warn=true) paths filename =
errorlabstrm "System.find_file_in_path"
(hov 0 (str "Can't find file" ++ spc () ++ str filename))
else
+ (* the name is considered to be the transcription as a relative
+ physical name of a logical name, so we deal with it as a name
+ to be locate respecting case *)
try where_in_path ~warn paths filename
with Not_found ->
errorlabstrm "System.find_file_in_path"