From 7af3bdf56f278e8928df7bdf63fddd159be610ec Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Tue, 20 Jun 2017 16:26:24 +0200 Subject: Add AppVeyor infrastructure, launching the test suite under Windows. --- appveyor.yml | 26 ++++++++++++++++++++++++++ dev/build/windows/appveyor.sh | 8 ++++++++ 2 files changed, 34 insertions(+) create mode 100644 appveyor.yml create mode 100644 dev/build/windows/appveyor.sh diff --git a/appveyor.yml b/appveyor.yml new file mode 100644 index 0000000000..e57e7e946c --- /dev/null +++ b/appveyor.yml @@ -0,0 +1,26 @@ +version: '{branch}~{build}' +clone_depth: 10 + +platform: +- x64 + +image: +- Visual Studio 2017 + +environment: + CYGROOT: C:\cygwin64 + CYGMIRROR: http://ftp.inf.tu-dresden.de/software/windows/cygwin32 + CYGCACHE: C:\cygwin64\var\cache\setup + opam_url: https://github.com/fdopen/opam-repository-mingw/releases/download/0.0.0.1/opam64.tar.xz + +install: +- cmd: '%CYGROOT%\setup-x86_64.exe -qnNdO -R %CYGROOT% -l %CYGCACHE% -s + %CYGMIRROR% -P rsync -P patch -P diffutils -P curl -P make -P unzip -P git -p m4 + -P perl -P findutils' +- cmd: '%CYGROOT%/bin/bash -l %APPVEYOR_BUILD_FOLDER%/dev/build/windows/appveyor.sh' + +build_script: +- cmd: '%CYGROOT%/bin/bash -lc "cd $APPVEYOR_BUILD_FOLDER && ./configure -local && make"' + +test_script: +- cmd: '%CYGROOT%/bin/bash -lc "cd $APPVEYOR_BUILD_FOLDER && make -C test-suite && make validate"' diff --git a/dev/build/windows/appveyor.sh b/dev/build/windows/appveyor.sh new file mode 100644 index 0000000000..53f7a23466 --- /dev/null +++ b/dev/build/windows/appveyor.sh @@ -0,0 +1,8 @@ +#!/bin/bash +set -e -x +wget $opam_url +tar -xf opam64.tar.xz +bash opam64/install.sh +opam init -a mingw https://github.com/fdopen/opam-repository-mingw.git --comp 4.02.3+mingw64c --switch 4.02.3+mingw64c +eval $(opam config env) +opam install -y ocamlfind camlp5 -- cgit v1.2.3 From 9682fea9f71477af58681735d8829507991d27c5 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Wed, 21 Jun 2017 14:51:42 +0200 Subject: Make coqlib relative in test suite (revert 024a7ab20b0) --- test-suite/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test-suite/Makefile b/test-suite/Makefile index 5ab4cacdaf..52127a45d7 100644 --- a/test-suite/Makefile +++ b/test-suite/Makefile @@ -27,8 +27,8 @@ # Default value when called from a freshly compiled Coq, but can be # easily overridden -LIB := $(shell cd ..; pwd) -BIN := $(LIB)/bin/ +LIB := .. +BIN := $(shell cd ..; pwd)/bin/ coqtop := $(BIN)coqtop -coqlib $(LIB) -boot -q -batch -test-mode -R prerequisite TestSuite coqc := $(BIN)coqc -coqlib $(LIB) -R prerequisite TestSuite -- cgit v1.2.3 From 8fdc88a79837c70857c51fcb3e0930f1ac3e9c8a Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Tue, 27 Jun 2017 11:37:11 +0200 Subject: Remove non-terminating Timeout tests from Hints.v. --- test-suite/success/Hints.v | 5 ----- 1 file changed, 5 deletions(-) diff --git a/test-suite/success/Hints.v b/test-suite/success/Hints.v index 1abe14774c..6962e43e7e 100644 --- a/test-suite/success/Hints.v +++ b/test-suite/success/Hints.v @@ -37,7 +37,6 @@ Hint Resolve predf | 0 : predconv. Goal exists n, pred n. eexists. - Fail Timeout 1 typeclasses eauto with pred. Set Typeclasses Filtered Unification. Set Typeclasses Debug Verbosity 2. (* predf is not tried as it doesn't match the goal *) @@ -80,8 +79,6 @@ Qed. (** The other way around: goal contains redexes instead of instances *) Goal exists n, pred (0 + n). eexists. - (* predf is applied indefinitely *) - Fail Timeout 1 typeclasses eauto with pred. (* pred0 (pred _) matches the goal *) typeclasses eauto with predconv. Qed. @@ -169,8 +166,6 @@ Instance foo f : E (id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ f ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id). Proof. - Fail Timeout 1 apply _. (* 3.7s *) - Hint Cut [_* (a_is_b | b_is_c | c_is_d | d_is_e) (a_compose | b_compose | c_compose | d_compose | e_compose)] : typeclass_instances. -- cgit v1.2.3 From d70b9e9b901a836f80180200cfd591e05839ee28 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Tue, 27 Jun 2017 16:03:58 +0200 Subject: Print failure logs on appveyor. --- test-suite/Makefile | 1 + 1 file changed, 1 insertion(+) diff --git a/test-suite/Makefile b/test-suite/Makefile index 52127a45d7..3db3452416 100644 --- a/test-suite/Makefile +++ b/test-suite/Makefile @@ -170,6 +170,7 @@ summary.log: report: summary.log $(HIDE)./save-logs.sh $(HIDE)if [ -n "${TRAVIS}" ]; then find logs/ -name '*.log' -not -name 'summary.log' -exec 'bash' '-c' 'echo "travis_fold:start:coq.logs.$$(echo '{}' | sed s,/,.,g)"' ';' -exec cat '{}' ';' -exec 'bash' '-c' 'echo "travis_fold:end:coq.logs.$$(echo '{}' | sed s,/,.,g)"' ';'; fi + $(HIDE)if [ -n "${APPVEYOR}" ]; then find logs/ -name '*.log' -not -name 'summary.log' -exec 'bash' '-c' 'echo {}' ';' -exec cat '{}' ';' -exec 'bash' '-c' 'echo' ';'; fi $(HIDE)if grep -q -F 'Error!' summary.log ; then echo FAILURES; grep -F 'Error!' summary.log; false; else echo NO FAILURES; fi ####################################################################### -- cgit v1.2.3 From e61ccdcf8d30b2d9998ba4851ea7691114977b57 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Tue, 27 Jun 2017 17:17:59 +0200 Subject: Remove trailing CR before diff in output and misc tests. --- test-suite/Makefile | 4 ++-- test-suite/misc/deps-order.sh | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/test-suite/Makefile b/test-suite/Makefile index 3db3452416..a88fb6bc63 100644 --- a/test-suite/Makefile +++ b/test-suite/Makefile @@ -294,7 +294,7 @@ $(addsuffix .log,$(wildcard output/*.v)): %.v.log: %.v %.out $(PREREQUISITELOG) | grep -v "^" \ | sed 's/File "[^"]*"/File "stdin"/' \ > $$tmpoutput; \ - diff -u $*.out $$tmpoutput 2>&1; R=$$?; times; \ + diff -u --strip-trailing-cr $*.out $$tmpoutput 2>&1; R=$$?; times; \ if [ $$R = 0 ]; then \ echo $(log_success); \ echo " $<...Ok"; \ @@ -329,7 +329,7 @@ $(addsuffix .log,$(wildcard output-modulo-time/*.v)): %.v.log: %.v %.out -e 's/\s*[-+]inf\s*//g' \ -e 's/^[^a-zA-Z]*//' \ $*.out | sort > $$tmpexpected; \ - diff -b -u $$tmpexpected $$tmpoutput 2>&1; R=$$?; times; \ + diff --strip-trailing-cr -b -u $$tmpexpected $$tmpoutput 2>&1; R=$$?; times; \ if [ $$R = 0 ]; then \ echo $(log_success); \ echo " $<...Ok"; \ diff --git a/test-suite/misc/deps-order.sh b/test-suite/misc/deps-order.sh index 00c5eb1bd5..299f494693 100755 --- a/test-suite/misc/deps-order.sh +++ b/test-suite/misc/deps-order.sh @@ -4,7 +4,7 @@ rm -f misc/deps/lib/*.vo misc/deps/client/*.vo tmpoutput=`mktemp /tmp/coqcheck.XXXXXX` $coqdep -R misc/deps/lib lib -R misc/deps/client client misc/deps/client/bar.v 2>&1 | head -n 1 > $tmpoutput -diff -u misc/deps/deps.out $tmpoutput 2>&1 +diff -u --strip-trailing-cr misc/deps/deps.out $tmpoutput 2>&1 R=$? times $coqc -R misc/deps/lib lib misc/deps/lib/foo.v 2>&1 -- cgit v1.2.3 From 52efb4dfb9810bbb749185f24916a43331abc817 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Tue, 27 Jun 2017 18:20:51 +0200 Subject: Avoid using unsupported signals under Windows in fake_ide. --- tools/fake_ide.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/fake_ide.ml b/tools/fake_ide.ml index c0d2e4d6b5..2718461243 100644 --- a/tools/fake_ide.ml +++ b/tools/fake_ide.ml @@ -293,7 +293,7 @@ let usage () = module Coqide = Spawn.Sync(struct end) let main = - Sys.set_signal Sys.sigpipe + if Sys.os_type = "Unix" then Sys.set_signal Sys.sigpipe (Sys.Signal_handle (fun _ -> prerr_endline "Broken Pipe (coqtop died ?)"; exit 1)); let def_args = ["--xml_format=Ppcmds"; "-ideslave"] in -- cgit v1.2.3 From da2d3108f126b3ff7bface118319bfa43829a895 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Thu, 13 Jul 2017 16:50:10 +0200 Subject: In fake_ide, call coqtop.exe instead of coqtop on Win32. --- tools/fake_ide.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tools/fake_ide.ml b/tools/fake_ide.ml index 2718461243..258633d29b 100644 --- a/tools/fake_ide.ml +++ b/tools/fake_ide.ml @@ -298,7 +298,8 @@ let main = (fun _ -> prerr_endline "Broken Pipe (coqtop died ?)"; exit 1)); let def_args = ["--xml_format=Ppcmds"; "-ideslave"] in let coqtop_name, coqtop_args, input_file = match Sys.argv with - | [| _; f |] -> "coqtop", Array.of_list def_args, f + | [| _; f |] -> (if Sys.os_type = "Unix" then "coqtop" else "coqtop.exe"), + Array.of_list def_args, f | [| _; f; ct |] -> let ct = Str.split (Str.regexp " ") ct in List.hd ct, Array.of_list (def_args @ List.tl ct), f -- cgit v1.2.3 From 7f7075d10780fe24c97e329868a501c2af422625 Mon Sep 17 00:00:00 2001 From: Enrico Tassi Date: Mon, 17 Jul 2017 10:50:04 +0200 Subject: coq-makefile: make test suite detect more errors Replacing ; with && and enabling bash's pipefail option --- test-suite/coq-makefile/arg/run.sh | 3 --- test-suite/coq-makefile/compat-subdirs/run.sh | 4 +--- test-suite/coq-makefile/coqdoc1/run.sh | 5 +---- test-suite/coq-makefile/coqdoc2/run.sh | 5 +---- test-suite/coq-makefile/extend-subdirs/run.sh | 3 --- test-suite/coq-makefile/latex1/run.sh | 3 --- test-suite/coq-makefile/merlin1/run.sh | 3 --- test-suite/coq-makefile/mlpack1/run.sh | 5 +---- test-suite/coq-makefile/mlpack2/run.sh | 5 +---- test-suite/coq-makefile/multiroot/run.sh | 5 +---- test-suite/coq-makefile/native1/run.sh | 5 +---- test-suite/coq-makefile/only/run.sh | 3 --- test-suite/coq-makefile/plugin1/run.sh | 5 +---- test-suite/coq-makefile/plugin2/run.sh | 5 +---- test-suite/coq-makefile/plugin3/run.sh | 5 +---- test-suite/coq-makefile/template/init.sh | 2 ++ test-suite/coq-makefile/uninstall1/run.sh | 5 +---- test-suite/coq-makefile/uninstall2/run.sh | 5 +---- test-suite/coq-makefile/validate1/run.sh | 3 --- 19 files changed, 14 insertions(+), 65 deletions(-) diff --git a/test-suite/coq-makefile/arg/run.sh b/test-suite/coq-makefile/arg/run.sh index e98da17c78..aa0f50001a 100755 --- a/test-suite/coq-makefile/arg/run.sh +++ b/test-suite/coq-makefile/arg/run.sh @@ -1,8 +1,5 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh coq_makefile -f _CoqProject -o Makefile diff --git a/test-suite/coq-makefile/compat-subdirs/run.sh b/test-suite/coq-makefile/compat-subdirs/run.sh index 28d9878f9b..211f73adc7 100755 --- a/test-suite/coq-makefile/compat-subdirs/run.sh +++ b/test-suite/coq-makefile/compat-subdirs/run.sh @@ -1,9 +1,7 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh + coq_makefile -f _CoqProject -o Makefile make exec test -f "subdir/done" diff --git a/test-suite/coq-makefile/coqdoc1/run.sh b/test-suite/coq-makefile/coqdoc1/run.sh index e8291c89da..78e30bd354 100755 --- a/test-suite/coq-makefile/coqdoc1/run.sh +++ b/test-suite/coq-makefile/coqdoc1/run.sh @@ -1,8 +1,5 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh coq_makefile -f _CoqProject -o Makefile @@ -11,7 +8,7 @@ make html mlihtml make install DSTROOT="$PWD/tmp" make install-doc DSTROOT="$PWD/tmp" #make debug -(for d in `find tmp -name user-contrib`; do pushd $d >/dev/null; find .; popd >/dev/null; done) | sort -u > actual +(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual sort -u > desired </dev/null; find .; popd >/dev/null; done) | sort -u > actual +(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual sort -u > desired < actual +(cd `find tmp -name user-contrib` && find .) | sort > actual sort > desired < actual +(cd `find tmp -name user-contrib` && find .) | sort > actual sort > desired </dev/null; find .; popd >/dev/null; done) | sort -u > actual +(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual sort > desired < actual +(cd `find tmp -name user-contrib` && find .) | sort > actual sort > desired < actual +(cd `find tmp -name user-contrib` && find .) | sort > actual sort > desired < actual +(cd `find tmp -name user-contrib` && find .) | sort > actual sort > desired < actual +(cd `find tmp -name user-contrib` && find .) | sort > actual sort > desired </dev/null; find .; popd >/dev/null; done) | sort -u > actual +(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual sort -u > desired </dev/null; find .; popd >/dev/null; done) | sort -u > actual +(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual sort -u > desired < desired < dash2 "R" path l) r_includes)) ;; +let windrive s = + if Coq_config.arch_is_win32 && Str.(string_match (regexp "^[a-zA-Z]:") s 0) + then Str.matched_string s + else s +;; + let generate_conf_coq_config oc args bypass_API = section oc "Coq configuration."; let src_dirs = if bypass_API then Coq_config.all_src_dirs else Coq_config.api_dirs @ Coq_config.plugins_dirs @ ["-open API"] in Envars.print_config ~prefix_var_name:"COQMF_" oc src_dirs; + fprintf oc "COQMF_WINDRIVE=%s\n" (windrive Coq_config.coqlib) ;; let generate_conf_files oc -- cgit v1.2.3 From e234f3ef8161f0b30c5189c629e856af04a66340 Mon Sep 17 00:00:00 2001 From: Enrico Tassi Date: Tue, 18 Jul 2017 11:22:15 +0200 Subject: Windows: Sys.is_dir "foo/" always says no (so we strip trailing slash) --- lib/minisys.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) 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) *) -- cgit v1.2.3 From 2c5cc812d37da3f03abe3a0fb8029d1c74ad7b82 Mon Sep 17 00:00:00 2001 From: Enrico Tassi Date: Tue, 18 Jul 2017 14:07:59 +0200 Subject: coq_makefile: use System.exists_dir for better portability --- lib/coqProject_file.ml4 | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) 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] } -- cgit v1.2.3 From ecf880d0c50f7be9ab80893ae1fcc6714b3a2309 Mon Sep 17 00:00:00 2001 From: Enrico Tassi Date: Wed, 19 Jul 2017 12:55:39 +0200 Subject: fake_ide: do as coqide to find out coqtop path --- test-suite/Makefile | 2 +- tools/fake_ide.ml | 20 ++++++++++++++++---- 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/test-suite/Makefile b/test-suite/Makefile index a88fb6bc63..beb80a3dfd 100644 --- a/test-suite/Makefile +++ b/test-suite/Makefile @@ -446,7 +446,7 @@ ide : $(patsubst %.fake,%.fake.log,$(wildcard ide/*.fake)) @echo "TEST $<" $(HIDE){ \ echo $(call log_intro,$<); \ - $(BIN)fake_ide $< "$(BIN)coqtop -coqlib $(LIB) -boot -async-proofs on -async-proofs-tactic-error-resilience off -async-proofs-command-error-resilience off" 2>&1; \ + $(BIN)fake_ide $< "-coqlib $(LIB) -boot -async-proofs on -async-proofs-tactic-error-resilience off -async-proofs-command-error-resilience off" 2>&1; \ if [ $$? = 0 ]; then \ echo $(log_success); \ echo " $<...Ok"; \ diff --git a/tools/fake_ide.ml b/tools/fake_ide.ml index 258633d29b..a9da27ba23 100644 --- a/tools/fake_ide.ml +++ b/tools/fake_ide.ml @@ -297,12 +297,24 @@ let main = (Sys.Signal_handle (fun _ -> prerr_endline "Broken Pipe (coqtop died ?)"; exit 1)); let def_args = ["--xml_format=Ppcmds"; "-ideslave"] in - let coqtop_name, coqtop_args, input_file = match Sys.argv with - | [| _; f |] -> (if Sys.os_type = "Unix" then "coqtop" else "coqtop.exe"), - Array.of_list def_args, f + let coqtop_name = (* from ide/ideutils.ml *) + let prog_name = "fake_ide" in + let len_prog_name = String.length prog_name in + let fake_ide_path = Sys.executable_name in + let fake_ide_path_len = String.length fake_ide_path in + let pos = fake_ide_path_len - len_prog_name in + let rex = Str.regexp_string prog_name in + try + let i = Str.search_backward rex fake_ide_path pos in + String.sub fake_ide_path 0 i ^ "coqtop" ^ + String.sub fake_ide_path (i + len_prog_name) + (fake_ide_path_len - i - len_prog_name) + with Not_found -> assert false in + let coqtop_args, input_file = match Sys.argv with + | [| _; f |] -> Array.of_list def_args, f | [| _; f; ct |] -> let ct = Str.split (Str.regexp " ") ct in - List.hd ct, Array.of_list (def_args @ List.tl ct), f + Array.of_list (def_args @ ct), f | _ -> usage () in let inc = if input_file = "-" then stdin else open_in input_file in let coq = -- cgit v1.2.3 From a6f5bd2bdc01eeebf1617dd3b0c6823f4aac438c Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Fri, 21 Jul 2017 08:43:22 +0200 Subject: Install time command under Cygwin (required for timing scripts). --- appveyor.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/appveyor.yml b/appveyor.yml index e57e7e946c..ec6ded7218 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -16,7 +16,7 @@ environment: install: - cmd: '%CYGROOT%\setup-x86_64.exe -qnNdO -R %CYGROOT% -l %CYGCACHE% -s %CYGMIRROR% -P rsync -P patch -P diffutils -P curl -P make -P unzip -P git -p m4 - -P perl -P findutils' + -P perl -P findutils -P time' - cmd: '%CYGROOT%/bin/bash -l %APPVEYOR_BUILD_FOLDER%/dev/build/windows/appveyor.sh' build_script: -- cgit v1.2.3 From 5b3d0f2cd7a5f480fe24a938e2f6713798c7139a Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Fri, 21 Jul 2017 15:22:28 +0200 Subject: PMP sold us a Timeout on Windows with 1s resolution. Trying to improve it. --- lib/control.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 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 -- cgit v1.2.3