aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorMaxime Dénès2017-07-21 17:14:29 +0200
committerMaxime Dénès2017-07-21 17:14:29 +0200
commitc0fdb912c5e63bb43d6e8dd320e9f5613c6237ff (patch)
treeab0e7f43c58a2554f78f317893eb69120dae5dd4 /lib
parentf30269579b78d5bf65dcd5db70e341fe9598b274 (diff)
parent5b3d0f2cd7a5f480fe24a938e2f6713798c7139a (diff)
Merge PR #897: Fix test suite on windows (wrt fake_ide and coq-makefile)
Diffstat (limited to 'lib')
-rw-r--r--lib/control.ml6
-rw-r--r--lib/coqProject_file.ml414
-rw-r--r--lib/minisys.ml6
3 files changed, 18 insertions, 8 deletions
diff --git a/lib/control.ml b/lib/control.ml
index d9b91be3a0..f5d7df204e 100644
--- a/lib/control.ml
+++ b/lib/control.ml
@@ -48,7 +48,7 @@ let windows_timeout n f e =
let exited = ref false in
let thread init =
while not !killed do
- let cur = Unix.time () in
+ let cur = Unix.gettimeofday () in
if float_of_int n <= cur -. init then begin
interrupt := true;
exited := true;
@@ -57,12 +57,12 @@ let windows_timeout n f e =
Thread.delay 0.5
done
in
- let init = Unix.time () in
+ let init = Unix.gettimeofday () in
let _id = Thread.create thread init in
try
let res = f () in
let () = killed := true in
- let cur = Unix.time () in
+ let cur = Unix.gettimeofday () in
(** The thread did not interrupt, but the computation took longer than
expected. *)
let () = if float_of_int n <= cur -. init then begin
diff --git a/lib/coqProject_file.ml4 b/lib/coqProject_file.ml4
index bb3cbabbd6..13de731f54 100644
--- a/lib/coqProject_file.ml4
+++ b/lib/coqProject_file.ml4
@@ -73,9 +73,6 @@ let rec post_canonize f =
if dir = Filename.current_dir_name then f else post_canonize dir
else f
-(* Avoid Sys.is_directory raise an exception (if the file does not exists) *)
-let is_directory f = Sys.file_exists f && Sys.is_directory f
-
(********************* parser *******************************************)
exception Parsing_error of string
@@ -106,6 +103,15 @@ let parse f =
res
;;
+(* Copy from minisys.ml, since we don't see that file here *)
+let exists_dir dir =
+ let rec strip_trailing_slash dir =
+ let len = String.length dir in
+ if len > 0 && (dir.[len-1] = '/' || dir.[len-1] = '\\')
+ then strip_trailing_slash (String.sub dir 0 (len-1)) else dir in
+ try Sys.is_directory (strip_trailing_slash dir) with Sys_error _ -> false
+
+
let process_cmd_line orig_dir proj args =
let orig_dir = (* avoids turning foo.v in ./foo.v *)
if orig_dir = "." then "" else orig_dir in
@@ -173,7 +179,7 @@ let process_cmd_line orig_dir proj args =
| f :: r ->
let f = CUnix.correct_path f orig_dir in
let proj =
- if is_directory f then { proj with subdirs = proj.subdirs @ [f] }
+ if exists_dir f then { proj with subdirs = proj.subdirs @ [f] }
else match CUnix.get_extension f with
| ".v" -> { proj with v_files = proj.v_files @ [f] }
| ".ml" -> { proj with ml_files = proj.ml_files @ [f] }
diff --git a/lib/minisys.ml b/lib/minisys.ml
index b4382a3fe7..1ed017e489 100644
--- a/lib/minisys.ml
+++ b/lib/minisys.ml
@@ -44,7 +44,11 @@ let ok_dirname f =
(* Check directory can be opened *)
let exists_dir dir =
- try Sys.is_directory dir with Sys_error _ -> false
+ let rec strip_trailing_slash dir =
+ let len = String.length dir in
+ if len > 0 && (dir.[len-1] = '/' || dir.[len-1] = '\\')
+ then strip_trailing_slash (String.sub dir 0 (len-1)) else dir in
+ try Sys.is_directory (strip_trailing_slash dir) with Sys_error _ -> false
let apply_subdir f path name =
(* we avoid all files and subdirs starting by '.' (e.g. .svn) *)