diff --git a/COVERAGE.md b/COVERAGE.md new file mode 100644 index 000000000..d8ea101f1 --- /dev/null +++ b/COVERAGE.md @@ -0,0 +1,45 @@ + +# Coverage Analysis + +This project can be compiled for coverage analysis using [bisect_ppx]. By +default, this is not done. To compile for coverage analysis, do: + + make coverage + make + +The `coverage` target adds the rules in `_tags.coverage` to the `_tags` +file, which in turn causes all code to be compiled for coverage +analysis. The `_tags.coverage` file could be tweaked to control which +files get instrumented. + +## Support Files + +See [profiling/coverage.ml](./profiling/coverage.ml) for the run-time +setup of coverage profiling. This code has no effect when not profiling +during execution. Once [bixect_ppx] has better defaults we could get rid +of it. + +## Execution and Logging + +During program execution, a binary writes coverage data to + + /tmp/bisect--*.out + +This can be overridden by setting the `BISECT_FILE` environment +variable, which is otherwise set at startup using the code in +`profiling/coverage.ml`; + +## Analysis + +See the [bisect_ppx] documentation for details but try from the +top-level directory: + + bisect-ppx-report -I _build -html coverage /tmp/bisect-*.out + +This creates an HTML document in [coverage/](./coverage]. + +[bisect_ppx]: https://github.com/aantron/bisect_ppx + + + + diff --git a/Makefile b/Makefile index ef55f7739..98ea92ab9 100644 --- a/Makefile +++ b/Makefile @@ -97,3 +97,20 @@ release: grep -v 'warn-error' _oasis > _oasis.tmp mv _oasis.tmp _oasis oasis setup + +# make coverage - prepares for building with coverage analysis +# make uncover - reverses the setup from "make coverage" +# make report - create coverage/index.html + +coverage: _tags _tags.coverage + test ! -f _tags.orig && mv _tags _tags.orig || true + cat _tags.coverage _tags.orig > _tags + +uncover: _tags.orig + mv _tags.orig _tags + +report: + bisect-ppx-report -I _build -html coverage /tmp/bisect-xenops*out + +.PHONY: report coverage uncover + diff --git a/README.md b/README.md index 8705734b0..1a7c739f0 100644 --- a/README.md +++ b/README.md @@ -9,3 +9,10 @@ xenopsd manages VMs running and provides a simple RPC control interface to the layer above (typically xapi). +## Coverage Profiling + +This code can be profiled for coverage. See [COVERAGE.md]. + + +[COVERAGE.md]: ./COVERAGE.md + diff --git a/_oasis b/_oasis index 60af38763..bcdb75f45 100644 --- a/_oasis +++ b/_oasis @@ -23,14 +23,68 @@ Flag simulator Description: Build server with simulator support Default: true + +# Support files for profiling +Library profiling + CompiledObject: best + Path: profiling + Install: false + Findlibname: profiling + Modules: Coverage + BuildDepends: + Library xenopsd CompiledObject: best Path: lib Findlibname: xenopsd ByteOpt: -warn-error +a NativeOpt: -warn-error +a - Modules: Suspend_image, Cancellable_subprocess, Bootloader, Ionice, Mac, Xenops_migrate, Xenops_hooks, Task_server, Xenops_task, Updates, Xenops_utils, Xenops_server, Xenopsd, Xenops_server_plugin, Xenops_server_skeleton, Scheduler, Path, Storage, Interface, Xenctrl_uuid, Xenstore, Version - BuildDepends: threads, threads.posix, uuidm, xmlm, cohttp, uri, rpclib, rpclib.syntax, forkexec, fd-send-recv, xcp, xcp.xen, xcp.storage, sexplib, sexplib.syntax, xcp, uutf, xenstore, xenstore.unix, xenstore_transport, xenstore_transport.unix, oclock + Modules: + Suspend_image, + Cancellable_subprocess, + Bootloader, + Ionice, + Mac, + Xenops_migrate, + Xenops_hooks, + Task_server, + Xenops_task, + Updates, + Xenops_utils, + Xenops_server, + Xenopsd, + Xenops_server_plugin, + Xenops_server_skeleton, + Scheduler, + Path, + Storage, + Interface, + Xenctrl_uuid, + Xenstore, + Version + BuildDepends: + threads, + threads.posix, + uuidm, + xmlm, + cohttp, + uri, + rpclib, + rpclib.syntax, + forkexec, + fd-send-recv, + xcp, + xcp.xen, + xcp.storage, + sexplib, + sexplib.syntax, + xcp, + uutf, + xenstore, + xenstore.unix, + xenstore_transport, + xenstore_transport.unix, + oclock CSources: sockopt_stubs.c Executable set_domain_uuid @@ -40,7 +94,11 @@ Executable set_domain_uuid NativeOpt: -warn-error +a-3 MainIs: set_domain_uuid.ml Install: false - BuildDepends: xenctrl, uuidm, cmdliner + BuildDepends: + xenctrl, + uuidm, + cmdliner, + profiling Executable suspend_image_viewer CompiledObject: best @@ -49,7 +107,10 @@ Executable suspend_image_viewer NativeOpt: -warn-error +a-3 MainIs: suspend_image_viewer.ml Install: false - BuildDepends: xenopsd, cmdliner + BuildDepends: + xenopsd, + cmdliner, + profiling Executable xenopsd_xc_main CompiledObject: best @@ -60,7 +121,23 @@ Executable xenopsd_xc_main Build$: flag(xen) Custom: true Install: false - BuildDepends: xenctrl, xenopsd, xenstore, xenstore.unix, xenstore_transport, xenstore_transport.unix, rpclib, forkexec, xcp, xcp.storage, xcp.memory, xcp.rrd, rrd, sexplib, xcp-inventory + BuildDepends: + xenctrl, + xenopsd, + xenstore, + xenstore.unix, + xenstore_transport, + xenstore_transport.unix, + rpclib, + forkexec, + xcp, + xcp.storage, + xcp.memory, + xcp.rrd, + rrd, + sexplib, + xcp-inventory, + profiling CSources: fsync_stubs.c, xenctrlext_stubs.c Executable watch_test @@ -70,7 +147,14 @@ Executable watch_test NativeOpt: -warn-error +a-3 MainIs: watch_test.ml Install: false - BuildDepends: xenopsd, xenstore, xenstore.unix, xenstore_transport, xenstore_transport.unix, threads + BuildDepends: + xenopsd, + xenstore, + xenstore.unix, + xenstore_transport, + xenstore_transport.unix, + threads, + profiling Executable xenopsd_simulator CompiledObject: best @@ -81,7 +165,9 @@ Executable xenopsd_simulator Build$: flag(simulator) Custom: true Install: false - BuildDepends: xenopsd + BuildDepends: + xenopsd, + profiling Executable xenopsd_libvirt_main CompiledObject: best @@ -92,7 +178,15 @@ Executable xenopsd_libvirt_main Build$: flag(libvirt) Custom: true Install: false - BuildDepends: xenopsd, rpclib, forkexec, xcp, xcp.storage, sexplib, libvirt + BuildDepends: + xenopsd, + rpclib, + forkexec, + xcp, + xcp.storage, + sexplib, + libvirt, + profiling Executable xenopsd_xenlight_main CompiledObject: best @@ -103,6 +197,23 @@ Executable xenopsd_xenlight_main Build$: flag(xenlight) Custom: true Install: false - BuildDepends: xenlight, xentoollog, xenctrl, xenopsd, xenstore, xenstore.unix, xenstore_transport, xenstore_transport.unix, rpclib, forkexec, xcp, xcp.storage, xcp.memory, sexplib, xcp-inventory, optcomp + BuildDepends: + xenlight, + xentoollog, + xenctrl, + xenopsd, + xenstore, + xenstore.unix, + xenstore_transport, + xenstore_transport.unix, + rpclib, + forkexec, + xcp, + xcp.storage, + xcp.memory, + sexplib, + xcp-inventory, + optcomp, + profiling CSources: fsync_stubs.c, poll_stubs.c diff --git a/_tags b/_tags index 96f920f2d..22df0dad6 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 76fa96e6edac33c29cf074bb5b0859c0) +# DO NOT EDIT (digest: 75c8d08bbb53d180415f0183181b9cf1) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process @@ -14,6 +14,8 @@ true: annot, bin_annot ".git": not_hygienic "_darcs": -traverse "_darcs": not_hygienic +# Library profiling +"profiling/profiling.cmxs": use_profiling # Library xenopsd "lib/xenopsd.cmxs": use_xenopsd : oasis_library_xenopsd_byte @@ -52,9 +54,11 @@ true: annot, bin_annot : pkg_cmdliner : pkg_uuidm : pkg_xenctrl +: use_profiling : pkg_cmdliner : pkg_uuidm : pkg_xenctrl +: use_profiling # Executable suspend_image_viewer : oasis_executable_suspend_image_viewer_byte : oasis_executable_suspend_image_viewer_byte @@ -82,6 +86,7 @@ true: annot, bin_annot : pkg_xenstore_transport : pkg_xenstore_transport.unix : pkg_xmlm +: use_profiling : use_xenopsd : pkg_cmdliner : pkg_cohttp @@ -105,6 +110,7 @@ true: annot, bin_annot : pkg_xenstore_transport : pkg_xenstore_transport.unix : pkg_xmlm +: use_profiling : use_xenopsd # Executable xenopsd_xc_main : oasis_executable_xenopsd_xc_main_byte @@ -142,6 +148,7 @@ true: annot, bin_annot : pkg_xenstore_transport : pkg_xenstore_transport.unix : pkg_xmlm +: use_profiling : use_xenopsd : pkg_rrd : pkg_xcp-inventory @@ -174,6 +181,7 @@ true: annot, bin_annot "xc/fsync_stubs.c": pkg_xenstore_transport "xc/fsync_stubs.c": pkg_xenstore_transport.unix "xc/fsync_stubs.c": pkg_xmlm +"xc/fsync_stubs.c": use_profiling "xc/fsync_stubs.c": use_xenopsd "xc/xenctrlext_stubs.c": pkg_cohttp "xc/xenctrlext_stubs.c": pkg_fd-send-recv @@ -201,6 +209,7 @@ true: annot, bin_annot "xc/xenctrlext_stubs.c": pkg_xenstore_transport "xc/xenctrlext_stubs.c": pkg_xenstore_transport.unix "xc/xenctrlext_stubs.c": pkg_xmlm +"xc/xenctrlext_stubs.c": use_profiling "xc/xenctrlext_stubs.c": use_xenopsd : custom # Executable watch_test @@ -229,6 +238,7 @@ true: annot, bin_annot : pkg_xenstore_transport : pkg_xenstore_transport.unix : pkg_xmlm +: use_profiling : use_xenopsd : pkg_cohttp : pkg_fd-send-recv @@ -251,6 +261,7 @@ true: annot, bin_annot : pkg_xenstore_transport : pkg_xenstore_transport.unix : pkg_xmlm +: use_profiling : use_xenopsd # Executable xenopsd_simulator : oasis_executable_xenopsd_simulator_byte @@ -278,6 +289,7 @@ true: annot, bin_annot : pkg_xenstore_transport : pkg_xenstore_transport.unix : pkg_xmlm +: use_profiling : use_xenopsd : pkg_cohttp : pkg_fd-send-recv @@ -300,6 +312,7 @@ true: annot, bin_annot : pkg_xenstore_transport : pkg_xenstore_transport.unix : pkg_xmlm +: use_profiling : use_xenopsd : custom # Executable xenopsd_libvirt_main @@ -329,6 +342,7 @@ true: annot, bin_annot : pkg_xenstore_transport : pkg_xenstore_transport.unix : pkg_xmlm +: use_profiling : use_xenopsd : pkg_cohttp : pkg_fd-send-recv @@ -352,6 +366,7 @@ true: annot, bin_annot : pkg_xenstore_transport : pkg_xenstore_transport.unix : pkg_xmlm +: use_profiling : use_xenopsd : custom # Executable xenopsd_xenlight_main @@ -391,6 +406,7 @@ true: annot, bin_annot : pkg_xenstore_transport.unix : pkg_xentoollog : pkg_xmlm +: use_profiling : use_xenopsd : pkg_cohttp : pkg_fd-send-recv @@ -419,6 +435,7 @@ true: annot, bin_annot : pkg_xenstore_transport.unix : pkg_xentoollog : pkg_xmlm +: use_profiling : use_xenopsd "xl/fsync_stubs.c": pkg_cohttp "xl/fsync_stubs.c": pkg_fd-send-recv @@ -447,6 +464,7 @@ true: annot, bin_annot "xl/fsync_stubs.c": pkg_xenstore_transport.unix "xl/fsync_stubs.c": pkg_xentoollog "xl/fsync_stubs.c": pkg_xmlm +"xl/fsync_stubs.c": use_profiling "xl/fsync_stubs.c": use_xenopsd "xl/poll_stubs.c": pkg_cohttp "xl/poll_stubs.c": pkg_fd-send-recv @@ -475,6 +493,7 @@ true: annot, bin_annot "xl/poll_stubs.c": pkg_xenstore_transport.unix "xl/poll_stubs.c": pkg_xentoollog "xl/poll_stubs.c": pkg_xmlm +"xl/poll_stubs.c": use_profiling "xl/poll_stubs.c": use_xenopsd : custom # OASIS_STOP diff --git a/_tags.coverage b/_tags.coverage new file mode 100644 index 000000000..8c543834f --- /dev/null +++ b/_tags.coverage @@ -0,0 +1,6 @@ +# START_COVERAGE +# coverage analysis with bisect_ppx +# compile and link with package bisect_ppx +<**/*.ml{,i,y}>: pkg_bisect_ppx +<**/*.native>: pkg_bisect_ppx +# END_COVERAGE diff --git a/lib/xenopsd.ml b/lib/xenopsd.ml index 2f6fcc461..10b77c5bc 100644 --- a/lib/xenopsd.ml +++ b/lib/xenopsd.ml @@ -58,6 +58,7 @@ let path () = Filename.concat !sockets_path "xenopsd" let forwarded_path () = path () ^ ".forwarded" (* receive an authenticated fd from xapi *) let json_path () = path () ^ ".json" + module Server = Xenops_interface.Server(Xenops_server) let rpc_fn call = @@ -99,6 +100,8 @@ let doc = String.concat "\n" [ "Xenopsd looks after a set of Xen domains, performing lifecycle operations including start/shutdown/migrate. A system may run multiple xenopsds, each looking after a different set of VMs. Xenopsd will always ignore domains that it hasn't been asked to manage. There are multiple xenopsd *backends*, including 'xc': which uses libxc directly and 'xenlight': which uses the new Xen libxl library (recommended)."; ] + + let configure ?(specific_options=[]) ?(specific_essential_paths=[]) ?(specific_nonessential_paths=[]) () = Debug.set_facility Syslog.Local5; @@ -117,6 +120,7 @@ let configure ?(specific_options=[]) ?(specific_essential_paths=[]) ?(specific_n error "%s" m; exit 1 + let main backend = Printexc.record_backtrace true; @@ -133,9 +137,18 @@ let main backend = ~rpc_fn () in + (** we need to catch this to make sure at_exit handlers are + * triggered. In particuar, triggers for the bisect_ppx coverage + * profiling *) + + let signal_handler n = + debug "caught signal %d" n; exit 0 in + Xcp_service.maybe_daemonize (); Sys.set_signal Sys.sigpipe Sys.Signal_ignore; + Sys.set_signal Sys.sigterm (Sys.Signal_handle signal_handler); + Xenops_utils.set_fs_backend (Some (if !persist diff --git a/libvirt/xenops_libvirt_main.ml b/libvirt/xenops_libvirt_main.ml index 02cfc4483..402544954 100644 --- a/libvirt/xenops_libvirt_main.ml +++ b/libvirt/xenops_libvirt_main.ml @@ -16,6 +16,7 @@ let specific_essential_paths = Path.hvm_guests @ Path.network_configuration (* Start the program with the libvirt backend *) let _ = + Coverage.init "xenopsd-libvirt"; Xenops_interface.queue_name := !Xenops_interface.queue_name ^ ".libvirt"; Xenops_utils.set_root "xenopsd/libvirt"; Xenopsd.configure @@ -23,3 +24,5 @@ let _ = (); Xenopsd.main (module Xenops_server_libvirt: Xenops_server_plugin.S) + +(* vim: ts=2 sw=2 noet *) diff --git a/myocamlbuild.ml b/myocamlbuild.ml index 9b12a1af5..4c83bd4d9 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -1,5 +1,5 @@ (* OASIS_START *) -(* DO NOT EDIT (digest: c4687943ad9b35db36fce435aeae72fd) *) +(* DO NOT EDIT (digest: 28a98a80b057607577ddf2e46a295148) *) module OASISGettext = struct (* # 22 "src/oasis/OASISGettext.ml" *) @@ -29,6 +29,166 @@ module OASISGettext = struct end +module OASISString = struct +(* # 22 "src/oasis/OASISString.ml" *) + + + (** Various string utilities. + + Mostly inspired by extlib and batteries ExtString and BatString libraries. + + @author Sylvain Le Gall + *) + + + let nsplitf str f = + if str = "" then + [] + else + let buf = Buffer.create 13 in + let lst = ref [] in + let push () = + lst := Buffer.contents buf :: !lst; + Buffer.clear buf + in + let str_len = String.length str in + for i = 0 to str_len - 1 do + if f str.[i] then + push () + else + Buffer.add_char buf str.[i] + done; + push (); + List.rev !lst + + + (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the + separator. + *) + let nsplit str c = + nsplitf str ((=) c) + + + let find ~what ?(offset=0) str = + let what_idx = ref 0 in + let str_idx = ref offset in + while !str_idx < String.length str && + !what_idx < String.length what do + if str.[!str_idx] = what.[!what_idx] then + incr what_idx + else + what_idx := 0; + incr str_idx + done; + if !what_idx <> String.length what then + raise Not_found + else + !str_idx - !what_idx + + + let sub_start str len = + let str_len = String.length str in + if len >= str_len then + "" + else + String.sub str len (str_len - len) + + + let sub_end ?(offset=0) str len = + let str_len = String.length str in + if len >= str_len then + "" + else + String.sub str 0 (str_len - len) + + + let starts_with ~what ?(offset=0) str = + let what_idx = ref 0 in + let str_idx = ref offset in + let ok = ref true in + while !ok && + !str_idx < String.length str && + !what_idx < String.length what do + if str.[!str_idx] = what.[!what_idx] then + incr what_idx + else + ok := false; + incr str_idx + done; + if !what_idx = String.length what then + true + else + false + + + let strip_starts_with ~what str = + if starts_with ~what str then + sub_start str (String.length what) + else + raise Not_found + + + let ends_with ~what ?(offset=0) str = + let what_idx = ref ((String.length what) - 1) in + let str_idx = ref ((String.length str) - 1) in + let ok = ref true in + while !ok && + offset <= !str_idx && + 0 <= !what_idx do + if str.[!str_idx] = what.[!what_idx] then + decr what_idx + else + ok := false; + decr str_idx + done; + if !what_idx = -1 then + true + else + false + + + let strip_ends_with ~what str = + if ends_with ~what str then + sub_end str (String.length what) + else + raise Not_found + + + let replace_chars f s = + let buf = Buffer.create (String.length s) in + String.iter (fun c -> Buffer.add_char buf (f c)) s; + Buffer.contents buf + + let lowercase_ascii = + replace_chars + (fun c -> + if (c >= 'A' && c <= 'Z') then + Char.chr (Char.code c + 32) + else + c) + + let uncapitalize_ascii s = + if s <> "" then + (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) + else + s + + let uppercase_ascii = + replace_chars + (fun c -> + if (c >= 'a' && c <= 'z') then + Char.chr (Char.code c - 32) + else + c) + + let capitalize_ascii s = + if s <> "" then + (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) + else + s + +end + module OASISExpr = struct (* # 22 "src/oasis/OASISExpr.ml" *) @@ -129,7 +289,7 @@ module OASISExpr = struct end -# 132 "myocamlbuild.ml" +# 292 "myocamlbuild.ml" module BaseEnvLight = struct (* # 22 "src/base/BaseEnvLight.ml" *) @@ -234,7 +394,7 @@ module BaseEnvLight = struct end -# 237 "myocamlbuild.ml" +# 397 "myocamlbuild.ml" module MyOCamlbuildFindlib = struct (* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *) @@ -516,7 +676,7 @@ module MyOCamlbuildBase = struct | nm, [], intf_modules -> ocaml_lib nm; let cmis = - List.map (fun m -> (String.uncapitalize m) ^ ".cmi") + List.map (fun m -> (OASISString.uncapitalize_ascii m) ^ ".cmi") intf_modules in dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis | nm, dir :: tl, intf_modules -> @@ -529,7 +689,7 @@ module MyOCamlbuildBase = struct ["compile"; "infer_interface"; "doc"]) tl; let cmis = - List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi") + List.map (fun m -> dir^"/"^(OASISString.uncapitalize_ascii m)^".cmi") intf_modules in dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"] cmis) @@ -603,11 +763,12 @@ module MyOCamlbuildBase = struct end -# 606 "myocamlbuild.ml" +# 766 "myocamlbuild.ml" open Ocamlbuild_plugin;; let package_default = { - MyOCamlbuildBase.lib_ocaml = [("xenopsd", ["lib"], [])]; + MyOCamlbuildBase.lib_ocaml = + [("profiling", ["profiling"], []); ("xenopsd", ["lib"], [])]; lib_c = [ ("xenopsd", "lib", []); @@ -895,10 +1056,12 @@ let package_default = ]; includes = [ - ("xl", ["lib"]); - ("xc", ["lib"]); - ("simulator", ["lib"]); - ("libvirt", ["lib"]) + ("xl", ["lib"; "profiling"]); + ("xc", ["lib"; "profiling"]); + ("tools", ["profiling"]); + ("simulator", ["lib"; "profiling"]); + ("libvirt", ["lib"; "profiling"]); + ("lib", ["profiling"]) ] } ;; @@ -907,6 +1070,6 @@ let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; -# 911 "myocamlbuild.ml" +# 1074 "myocamlbuild.ml" (* OASIS_STOP *) Ocamlbuild_plugin.dispatch dispatch_default;; diff --git a/opam b/opam index b006e614c..cad612285 100644 --- a/opam +++ b/opam @@ -29,6 +29,7 @@ depends: [ "oclock" "xapi-inventory" "optcomp" + "bisect_ppx" ] depopts: "libvirt" {> "0.6.1.2"} ocaml-version: [>= "4.01.0"] diff --git a/profiling/META b/profiling/META new file mode 100644 index 000000000..08ba5f0dd --- /dev/null +++ b/profiling/META @@ -0,0 +1,11 @@ +# OASIS_START +# DO NOT EDIT (digest: ee7e3fdd2b390090469a9e871a315e9c) +version = "0.12.0" +description = "XenServer domain managers" +archive(byte) = "profiling.cma" +archive(byte, plugin) = "profiling.cma" +archive(native) = "profiling.cmxa" +archive(native, plugin) = "profiling.cmxs" +exists_if = "profiling.cma" +# OASIS_STOP + diff --git a/profiling/_oasis b/profiling/_oasis new file mode 100644 index 000000000..ae4677bb7 --- /dev/null +++ b/profiling/_oasis @@ -0,0 +1,10 @@ + +# Support files for coverage profiling +Library coverage + CompiledObject: best + Path: profiling + Findlibname: coverage + Modules: Coverage + BuildDepends: + + diff --git a/profiling/coverage.ml b/profiling/coverage.ml new file mode 100644 index 000000000..1dbdff6a6 --- /dev/null +++ b/profiling/coverage.ml @@ -0,0 +1,18 @@ + +(** This module sets up the env variable for bisect_ppx which describes + * where log files are written. + *) + + +(** [init name] sets up coverage profiling for binary [name]. You could + * use [Sys.argv.(0)] for [name]. + *) + +let init name = + let (//) = Filename.concat in + let tmpdir = Filename.get_temp_dir_name () in + try + ignore (Sys.getenv "BISECT_FILE") + with Not_found -> + Unix.putenv "BISECT_FILE" (tmpdir // Printf.sprintf "bisect-%s-" name) + diff --git a/profiling/coverage.mldylib b/profiling/coverage.mldylib new file mode 100644 index 000000000..2c6e555c2 --- /dev/null +++ b/profiling/coverage.mldylib @@ -0,0 +1,4 @@ +# OASIS_START +# DO NOT EDIT (digest: 9841bdc50c4226cb6ec5db76494249e6) +Coverage +# OASIS_STOP diff --git a/profiling/coverage.mli b/profiling/coverage.mli new file mode 100644 index 000000000..25e9f6005 --- /dev/null +++ b/profiling/coverage.mli @@ -0,0 +1,7 @@ + + +(** [init name] sets up coverage profiling for binary [name]. You could + * use [Sys.argv.(0)] for [name]. + *) + +val init: string -> unit diff --git a/profiling/coverage.mllib b/profiling/coverage.mllib new file mode 100644 index 000000000..2c6e555c2 --- /dev/null +++ b/profiling/coverage.mllib @@ -0,0 +1,4 @@ +# OASIS_START +# DO NOT EDIT (digest: 9841bdc50c4226cb6ec5db76494249e6) +Coverage +# OASIS_STOP diff --git a/profiling/profiling.mldylib b/profiling/profiling.mldylib new file mode 100644 index 000000000..2c6e555c2 --- /dev/null +++ b/profiling/profiling.mldylib @@ -0,0 +1,4 @@ +# OASIS_START +# DO NOT EDIT (digest: 9841bdc50c4226cb6ec5db76494249e6) +Coverage +# OASIS_STOP diff --git a/profiling/profiling.mllib b/profiling/profiling.mllib new file mode 100644 index 000000000..2c6e555c2 --- /dev/null +++ b/profiling/profiling.mllib @@ -0,0 +1,4 @@ +# OASIS_START +# DO NOT EDIT (digest: 9841bdc50c4226cb6ec5db76494249e6) +Coverage +# OASIS_STOP diff --git a/setup.ml b/setup.ml index 79fd3967e..f971f1f9e 100644 --- a/setup.ml +++ b/setup.ml @@ -1,9 +1,9 @@ (* setup.ml generated for the first time by OASIS v0.3.0 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 6f6fe929d4b85590ded666e742264e21) *) +(* DO NOT EDIT (digest: a35c6712bc4eeadb8afbb52bb7533da3) *) (* - Regenerated by OASIS v0.4.5 + Regenerated by OASIS v0.4.6 Visit http://oasis.forge.ocamlcore.org for more information and documentation about functions used in this file. *) @@ -246,6 +246,33 @@ module OASISString = struct String.iter (fun c -> Buffer.add_char buf (f c)) s; Buffer.contents buf + let lowercase_ascii = + replace_chars + (fun c -> + if (c >= 'A' && c <= 'Z') then + Char.chr (Char.code c + 32) + else + c) + + let uncapitalize_ascii s = + if s <> "" then + (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) + else + s + + let uppercase_ascii = + replace_chars + (fun c -> + if (c >= 'a' && c <= 'z') then + Char.chr (Char.code c - 32) + else + c) + + let capitalize_ascii s = + if s <> "" then + (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) + else + s end @@ -315,19 +342,15 @@ module OASISUtils = struct let compare_csl s1 s2 = - String.compare (String.lowercase s1) (String.lowercase s2) + String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2) module HashStringCsl = Hashtbl.Make (struct type t = string - - let equal s1 s2 = - (String.lowercase s1) = (String.lowercase s2) - - let hash s = - Hashtbl.hash (String.lowercase s) + let equal s1 s2 = (compare_csl s1 s2) = 0 + let hash s = Hashtbl.hash (OASISString.lowercase_ascii s) end) module SetStringCsl = @@ -365,7 +388,7 @@ module OASISUtils = struct else buf in - String.lowercase buf + OASISString.lowercase_ascii buf end @@ -471,7 +494,7 @@ module PropList = struct order = Queue.create (); name_norm = (if case_insensitive then - String.lowercase + OASISString.lowercase_ascii else fun s -> s); } @@ -1822,13 +1845,13 @@ module OASISUnixPath = struct let capitalize_file f = let dir = dirname f in let base = basename f in - concat dir (String.capitalize base) + concat dir (OASISString.capitalize_ascii base) let uncapitalize_file f = let dir = dirname f in let base = basename f in - concat dir (String.uncapitalize base) + concat dir (OASISString.uncapitalize_ascii base) end @@ -2890,7 +2913,7 @@ module OASISFileUtil = struct end -# 2893 "setup.ml" +# 2916 "setup.ml" module BaseEnvLight = struct (* # 22 "src/base/BaseEnvLight.ml" *) @@ -2995,7 +3018,7 @@ module BaseEnvLight = struct end -# 2998 "setup.ml" +# 3021 "setup.ml" module BaseContext = struct (* # 22 "src/base/BaseContext.ml" *) @@ -5406,7 +5429,7 @@ module BaseSetup = struct end -# 5409 "setup.ml" +# 5432 "setup.ml" module InternalConfigurePlugin = struct (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *) @@ -5845,8 +5868,8 @@ module InternalInstallPlugin = struct let make_fnames modul sufx = List.fold_right begin fun sufx accu -> - (String.capitalize modul ^ sufx) :: - (String.uncapitalize modul ^ sufx) :: + (OASISString.capitalize_ascii modul ^ sufx) :: + (OASISString.uncapitalize_ascii modul ^ sufx) :: accu end sufx @@ -6270,7 +6293,7 @@ module InternalInstallPlugin = struct end -# 6273 "setup.ml" +# 6296 "setup.ml" module OCamlbuildCommon = struct (* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *) @@ -6648,7 +6671,7 @@ module OCamlbuildDocPlugin = struct end -# 6651 "setup.ml" +# 6674 "setup.ml" open OASISTypes;; let setup_t = @@ -6769,6 +6792,36 @@ let setup_t = Some "Build server with simulator support"; flag_default = [(OASISExpr.EBool true, true)] }); + Library + ({ + cs_name = "profiling"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + bs_build = [(OASISExpr.EBool true, true)]; + bs_install = [(OASISExpr.EBool true, false)]; + bs_path = "profiling"; + bs_compiled_object = Best; + bs_build_depends = []; + bs_build_tools = [ExternalTool "ocamlbuild"]; + bs_c_sources = []; + bs_data_files = []; + bs_ccopt = [(OASISExpr.EBool true, [])]; + bs_cclib = [(OASISExpr.EBool true, [])]; + bs_dlllib = [(OASISExpr.EBool true, [])]; + bs_dllpath = [(OASISExpr.EBool true, [])]; + bs_byteopt = [(OASISExpr.EBool true, [])]; + bs_nativeopt = [(OASISExpr.EBool true, [])] + }, + { + lib_modules = ["Coverage"]; + lib_pack = false; + lib_internal_modules = []; + lib_findlib_parent = None; + lib_findlib_name = Some "profiling"; + lib_findlib_containers = [] + }); Library ({ cs_name = "xenopsd"; @@ -6864,7 +6917,8 @@ let setup_t = [ FindlibPackage ("xenctrl", None); FindlibPackage ("uuidm", None); - FindlibPackage ("cmdliner", None) + FindlibPackage ("cmdliner", None); + InternalLibrary "profiling" ]; bs_build_tools = [ExternalTool "ocamlbuild"]; bs_c_sources = []; @@ -6893,7 +6947,8 @@ let setup_t = bs_build_depends = [ InternalLibrary "xenopsd"; - FindlibPackage ("cmdliner", None) + FindlibPackage ("cmdliner", None); + InternalLibrary "profiling" ]; bs_build_tools = [ExternalTool "ocamlbuild"]; bs_c_sources = []; @@ -6942,7 +6997,8 @@ let setup_t = FindlibPackage ("xcp.rrd", None); FindlibPackage ("rrd", None); FindlibPackage ("sexplib", None); - FindlibPackage ("xcp-inventory", None) + FindlibPackage ("xcp-inventory", None); + InternalLibrary "profiling" ]; bs_build_tools = [ExternalTool "ocamlbuild"]; bs_c_sources = ["fsync_stubs.c"; "xenctrlext_stubs.c"]; @@ -6975,7 +7031,8 @@ let setup_t = FindlibPackage ("xenstore.unix", None); FindlibPackage ("xenstore_transport", None); FindlibPackage ("xenstore_transport.unix", None); - FindlibPackage ("threads", None) + FindlibPackage ("threads", None); + InternalLibrary "profiling" ]; bs_build_tools = [ExternalTool "ocamlbuild"]; bs_c_sources = []; @@ -7005,7 +7062,11 @@ let setup_t = bs_install = [(OASISExpr.EBool true, false)]; bs_path = "simulator"; bs_compiled_object = Best; - bs_build_depends = [InternalLibrary "xenopsd"]; + bs_build_depends = + [ + InternalLibrary "xenopsd"; + InternalLibrary "profiling" + ]; bs_build_tools = [ExternalTool "ocamlbuild"]; bs_c_sources = []; bs_data_files = []; @@ -7045,7 +7106,8 @@ let setup_t = FindlibPackage ("xcp", None); FindlibPackage ("xcp.storage", None); FindlibPackage ("sexplib", None); - FindlibPackage ("libvirt", None) + FindlibPackage ("libvirt", None); + InternalLibrary "profiling" ]; bs_build_tools = [ExternalTool "ocamlbuild"]; bs_c_sources = []; @@ -7095,7 +7157,8 @@ let setup_t = FindlibPackage ("xcp.memory", None); FindlibPackage ("sexplib", None); FindlibPackage ("xcp-inventory", None); - FindlibPackage ("optcomp", None) + FindlibPackage ("optcomp", None); + InternalLibrary "profiling" ]; bs_build_tools = [ExternalTool "ocamlbuild"]; bs_c_sources = ["fsync_stubs.c"; "poll_stubs.c"]; @@ -7117,8 +7180,9 @@ let setup_t = plugin_data = [] }; oasis_fn = Some "_oasis"; - oasis_version = "0.4.5"; - oasis_digest = Some "\024\144vQR\019\204K\197j+s\136\022\193}"; + oasis_version = "0.4.6"; + oasis_digest = + Some "0\155\"O\170\029\131\031\024\144\024\186\191\135\132y"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7126,6 +7190,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7130 "setup.ml" +# 7194 "setup.ml" (* OASIS_STOP *) let () = setup ();; diff --git a/simulator/xenops_simulator_main.ml b/simulator/xenops_simulator_main.ml index 95ff47d9d..cd3c30a8e 100644 --- a/simulator/xenops_simulator_main.ml +++ b/simulator/xenops_simulator_main.ml @@ -14,6 +14,7 @@ (* Start the program with the simulator backend *) let _ = + Coverage.init "xenops-simulator"; Xenops_interface.queue_name := !Xenops_interface.queue_name ^ ".simulator"; Xenops_utils.set_root "xenopsd/simulator"; Xenopsd.configure (); diff --git a/xc/watch_test.ml b/xc/watch_test.ml index cdb21304f..c45b605d9 100644 --- a/xc/watch_test.ml +++ b/xc/watch_test.ml @@ -47,5 +47,7 @@ module Tests = struct end let _ = + Coverage.init "xenopsd-watch-test"; Scheduler.start(); - Tests.go () + Tests.go (); + exit 0 (* run at_exit hooks *) diff --git a/xc/xenops_xc_main.ml b/xc/xenops_xc_main.ml index 7499674a6..19d4c0a23 100644 --- a/xc/xenops_xc_main.ml +++ b/xc/xenops_xc_main.ml @@ -46,6 +46,7 @@ let make_var_run_xen () = (* Start the program with the xen backend *) let _ = + Coverage.init "xenopsd-xc"; (* set up coverage profiling *) Xenops_interface.queue_name := !Xenops_interface.queue_name ^ ".classic"; Xenops_utils.set_root "xenopsd/classic"; Xenopsd.configure diff --git a/xl/xenops_xl_main.ml b/xl/xenops_xl_main.ml index 8b4a58cdb..91972ea45 100644 --- a/xl/xenops_xl_main.ml +++ b/xl/xenops_xl_main.ml @@ -50,6 +50,7 @@ let make_var_run_xen () = (* Start the program with the xenlight backend *) let _ = + Coverage.init "xenopsd-xl"; Xenops_interface.queue_name := !Xenops_interface.queue_name ^ ".xenlight"; Xenops_utils.set_root "xenopsd/xenlight"; Xenopsd.configure