From fcc7337a15444cc0dce08928f5d40d92998d306a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:39:10 +0100 Subject: [PATCH 01/20] Port to jbuilder MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Some libraries still use camlp4 which requires splitting the lib internally into 3 parts: ppx-modules-needed-by-camlp4-module, camlp4-interface, rest of ppx modules. Signed-off-by: Edwin Török --- .gitignore | 16 +- .merlin | 30 - Makefile | 45 +- _oasis | 113 - _tags | 352 -- example/jbuild | 33 + lib/META | 96 - lib/jbuild | 53 + lib/xcp.mldylib | 12 - lib/xcp.mllib | 12 - lib/xcp_updates.mldylib | 6 - lib/xcp_updates.mllib | 6 - lib_test/jbuild | 34 + memory/jbuild | 41 + memory/xcp_memory.mldylib | 5 - memory/xcp_memory.mllib | 5 - myocamlbuild.ml | 915 ---- network/jbuild | 40 + network/xcp_network.mldylib | 6 - network/xcp_network.mllib | 6 - rrd/jbuild | 47 + rrd/xcp_rrd.mldylib | 7 - rrd/xcp_rrd.mllib | 7 - setup.ml | 9058 ----------------------------------- storage/META | 22 - storage/jbuild | 54 + storage/xcp_storage.mldylib | 8 - storage/xcp_storage.mllib | 8 - v6/jbuild | 40 + v6/xapi_v6.mldylib | 5 - v6/xapi_v6.mllib | 5 - opam => xcp.opam | 17 +- xen/jbuild | 45 + xen/xcp_xen.mldylib | 7 - xen/xcp_xen.mllib | 7 - 35 files changed, 412 insertions(+), 10751 deletions(-) delete mode 100644 .merlin delete mode 100644 _oasis delete mode 100644 _tags create mode 100644 example/jbuild delete mode 100644 lib/META create mode 100644 lib/jbuild delete mode 100644 lib/xcp.mldylib delete mode 100644 lib/xcp.mllib delete mode 100644 lib/xcp_updates.mldylib delete mode 100644 lib/xcp_updates.mllib create mode 100644 lib_test/jbuild create mode 100644 memory/jbuild delete mode 100644 memory/xcp_memory.mldylib delete mode 100644 memory/xcp_memory.mllib delete mode 100644 myocamlbuild.ml create mode 100644 network/jbuild delete mode 100644 network/xcp_network.mldylib delete mode 100644 network/xcp_network.mllib create mode 100644 rrd/jbuild delete mode 100644 rrd/xcp_rrd.mldylib delete mode 100644 rrd/xcp_rrd.mllib delete mode 100644 setup.ml delete mode 100644 storage/META create mode 100644 storage/jbuild delete mode 100644 storage/xcp_storage.mldylib delete mode 100644 storage/xcp_storage.mllib create mode 100644 v6/jbuild delete mode 100644 v6/xapi_v6.mldylib delete mode 100644 v6/xapi_v6.mllib rename opam => xcp.opam (79%) create mode 100644 xen/jbuild delete mode 100644 xen/xcp_xen.mldylib delete mode 100644 xen/xcp_xen.mllib diff --git a/.gitignore b/.gitignore index e88dc9dc..68d9c6a7 100644 --- a/.gitignore +++ b/.gitignore @@ -1,17 +1,5 @@ -*.annot -*.cmo -*.cma -*.cmi -*.a -*.o -*.cmx -*.cmxs -*.cmxa -*.native - +*.merlin +*.install *.swp _build -setup.bin -setup.data -setup.log diff --git a/.merlin b/.merlin deleted file mode 100644 index b915b546..00000000 --- a/.merlin +++ /dev/null @@ -1,30 +0,0 @@ -PKG cmdliner -PKG cohttp -PKG fd-send-recv -PKG lwt -PKG message_switch -PKG oUnit -PKG ppx_deriving_rpc -PKG ppx_sexp_conv -PKG re -PKG rpclib -PKG rrd -PKG sexplib -PKG threads -PKG unix -PKG uri -PKG xapi-backtrace -PKG xmlm -B +threads - -B _build/** - -S example -S lib -S lib_test -S memory -S network -S rrd -S storage -S v6 -S xen diff --git a/Makefile b/Makefile index 32cb07a1..531be29f 100644 --- a/Makefile +++ b/Makefile @@ -1,34 +1,29 @@ -.PHONY: all clean install build -all: build doc +.PHONY: build release install uninstall clean test doc reindent -NAME=xcp -J=4 +build: + jbuilder build @install --dev -j $$(getconf _NPROCESSORS_ONLN) -export OCAMLRUNPARAM=b +release: + jbuilder build @install -setup.bin: setup.ml - @ocamlopt.opt -o $@ $< || ocamlopt -o $@ $< || ocamlc -o $@ $< - @rm -f setup.cmx setup.cmi setup.o setup.cmo +install: + jbuilder install -setup.data: setup.bin - @./setup.bin -configure +uninstall: + jbuilder uninstall -build: setup.data setup.bin - @./setup.bin -build -j $(J) - -doc: setup.data setup.bin - @./setup.bin -doc -j $(J) +clean: + jbuilder clean -install: setup.bin - @./setup.bin -install +test: + jbuilder runtest --dev -j $$(getconf _NPROCESSORS_ONLN) -test: setup.bin build - @./setup.bin -test -verbose true +# requires odoc +doc: + jbuilder build @doc -reinstall: setup.bin - @ocamlfind remove $(NAME) || true - @./setup.bin -reinstall +gh-pages: + bash .docgen.sh -clean: - @ocamlbuild -clean - @rm -f setup.data setup.log setup.bin +reindent: + git ls-files '*.ml' '*.mli' | xargs ocp-indent --syntax cstruct -i diff --git a/_oasis b/_oasis deleted file mode 100644 index e8682d11..00000000 --- a/_oasis +++ /dev/null @@ -1,113 +0,0 @@ -OASISFormat: 0.4 -Name: xcp-idl -Version: 1.2.0 -Synopsis: Interface definitions and common boilerplate for the xapi toolstack -Authors: David Scott -License: LGPL-2.1 with OCaml linking exception -Plugins: META (0.2) -BuildTools: ocamlbuild - -Library xcp - CompiledObject: best - Path: lib - Findlibname: xcp - Modules: Cohttp_posix_io, Posix_channel, Open_uri, Xcp_client, Xcp_service, Xcp_channel, Xcp_channel_protocol, Syslog, Debug - CSources: syslog_stubs.c - BuildDepends: cmdliner, uri, re, cohttp, xmlm, unix, ppx_sexp_conv, sexplib, ppx_deriving_rpc, rpclib, rpclib.xml, threads, message_switch (>= 0.11.0), message_switch.unix, fd-send-recv, xcp-inventory, xapi-backtrace - -Library xcp_updates - CompiledObject: best - Path: lib - Findlibname: updates - Findlibparent: xcp - Modules: Updates, Task_server, Scheduler - -Library xcp_storage - CompiledObject: best - Path: storage - Findlibname: storage - Findlibparent: xcp - Modules: Storage_interface, Vdi_automaton, Storage_client, Storage_skeleton, Storage_skeleton_test - BuildDepends: xcp, threads, rpclib - -Executable storage_test - CompiledObject: best - Path: storage - MainIs: storage_test.ml - Install: false - BuildDepends: xcp, xcp.storage, oUnit, cmdliner - -Library xcp_network - CompiledObject: best - Path: network - Findlibname: network - Findlibparent: xcp - Modules: Network_interface, Network_client, Network_stats - BuildDepends: xcp, threads, rpclib - -Library xcp_rrd - CompiledObject: best - Path: rrd - Findlibname: rrd - Findlibparent: xcp - Modules: Data_source, Ds, Rrd_interface, Rrd_client - BuildDepends: xcp, threads, rpclib, rrd - -Library xcp_xen - CompiledObject: best - Path: xen - Findlibname: xen - Findlibparent: xcp - Modules: Xenops_interface, Xenops_types, Xenops_client, Device_number - BuildDepends: xcp, threads, ppx_deriving_rpc, rpclib - -Library xcp_memory - CompiledObject: best - Path: memory - Findlibname: memory - Findlibparent: xcp - Modules: Memory_interface, Memory_client - BuildDepends: xcp, threads, rpclib - -Library xapi_v6 - CompiledObject: best - Path: v6 - Findlibname: v6 - Findlibparent: xcp - Modules: V6_interface, V6_client - BuildDepends: xcp, threads, rpclib - -Executable channel_helper - CompiledObject: best - Path: lib - MainIs: channel_helper.ml - Custom: true - Install: false - BuildDepends: xcp, lwt, lwt.unix, cmdliner - -Executable lib_test - CompiledObject: best - Path: lib_test - MainIs: test.ml - Custom: true - Install: false - BuildDepends: lwt, lwt.unix, xcp, xcp.xen, threads, rpclib, oUnit, xcp.updates - -Test lib_test - Command: ./test.native -runner sequential - Run: true - -Executable example - CompiledObject: best - Path: example - MainIs: example.ml - Custom: true - Install: false - BuildDepends: lwt, lwt.unix, xcp, rpclib - -Executable memory_cli - CompiledObject: best - Path: memory - MainIs: memory_cli.ml - Install: false - BuildDepends: xcp.memory, cmdliner, rpclib.cmdliner, rpclib.markdown \ No newline at end of file diff --git a/_tags b/_tags deleted file mode 100644 index dfd440b6..00000000 --- a/_tags +++ /dev/null @@ -1,352 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: c2a2e2072ba30b89a3568ae322ce4992) -# 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 -true: annot, bin_annot -<**/.svn>: -traverse -<**/.svn>: not_hygienic -".bzr": -traverse -".bzr": not_hygienic -".hg": -traverse -".hg": not_hygienic -".git": -traverse -".git": not_hygienic -"_darcs": -traverse -"_darcs": not_hygienic -# Library xcp -"lib/xcp.cmxs": use_xcp -: use_libxcp_stubs -"lib/syslog_stubs.c": pkg_cmdliner -"lib/syslog_stubs.c": pkg_cohttp -"lib/syslog_stubs.c": pkg_fd-send-recv -"lib/syslog_stubs.c": pkg_message_switch -"lib/syslog_stubs.c": pkg_message_switch.unix -"lib/syslog_stubs.c": pkg_ppx_deriving_rpc -"lib/syslog_stubs.c": pkg_ppx_sexp_conv -"lib/syslog_stubs.c": pkg_re -"lib/syslog_stubs.c": pkg_rpclib -"lib/syslog_stubs.c": pkg_rpclib.xml -"lib/syslog_stubs.c": pkg_sexplib -"lib/syslog_stubs.c": pkg_threads -"lib/syslog_stubs.c": pkg_unix -"lib/syslog_stubs.c": pkg_uri -"lib/syslog_stubs.c": pkg_xapi-backtrace -"lib/syslog_stubs.c": pkg_xcp-inventory -"lib/syslog_stubs.c": pkg_xmlm -# Library xcp_updates -"lib/xcp_updates.cmxs": use_xcp_updates -# Library xcp_storage -"storage/xcp_storage.cmxs": use_xcp_storage -# Executable storage_test -: pkg_cmdliner -: pkg_cohttp -: pkg_fd-send-recv -: pkg_message_switch -: pkg_message_switch.unix -: pkg_oUnit -: pkg_ppx_deriving_rpc -: pkg_ppx_sexp_conv -: pkg_re -: pkg_rpclib -: pkg_rpclib.xml -: pkg_sexplib -: pkg_threads -: pkg_unix -: pkg_uri -: pkg_xapi-backtrace -: pkg_xcp-inventory -: pkg_xmlm -: use_xcp -: use_xcp_storage -: pkg_cmdliner -: pkg_cohttp -: pkg_fd-send-recv -: pkg_message_switch -: pkg_message_switch.unix -: pkg_oUnit -: pkg_ppx_deriving_rpc -: pkg_ppx_sexp_conv -: pkg_re -: pkg_rpclib -: pkg_rpclib.xml -: pkg_sexplib -: pkg_threads -: pkg_unix -: pkg_uri -: pkg_xapi-backtrace -: pkg_xcp-inventory -: pkg_xmlm -: use_xcp -: use_xcp_storage -# Library xcp_network -"network/xcp_network.cmxs": use_xcp_network -: pkg_cmdliner -: pkg_cohttp -: pkg_fd-send-recv -: pkg_message_switch -: pkg_message_switch.unix -: pkg_ppx_deriving_rpc -: pkg_ppx_sexp_conv -: pkg_re -: pkg_rpclib -: pkg_rpclib.xml -: pkg_sexplib -: pkg_threads -: pkg_unix -: pkg_uri -: pkg_xapi-backtrace -: pkg_xcp-inventory -: pkg_xmlm -: use_xcp -# Library xcp_rrd -"rrd/xcp_rrd.cmxs": use_xcp_rrd -: pkg_cmdliner -: pkg_cohttp -: pkg_fd-send-recv -: pkg_message_switch -: pkg_message_switch.unix -: pkg_ppx_deriving_rpc -: pkg_ppx_sexp_conv -: pkg_re -: pkg_rpclib -: pkg_rpclib.xml -: pkg_rrd -: pkg_sexplib -: pkg_threads -: pkg_unix -: pkg_uri -: pkg_xapi-backtrace -: pkg_xcp-inventory -: pkg_xmlm -: use_xcp -# Library xcp_xen -"xen/xcp_xen.cmxs": use_xcp_xen -: pkg_cmdliner -: pkg_cohttp -: pkg_fd-send-recv -: pkg_message_switch -: pkg_message_switch.unix -: pkg_ppx_deriving_rpc -: pkg_ppx_sexp_conv -: pkg_re -: pkg_rpclib -: pkg_rpclib.xml -: pkg_sexplib -: pkg_threads -: pkg_unix -: pkg_uri -: pkg_xapi-backtrace -: pkg_xcp-inventory -: pkg_xmlm -: use_xcp -# Library xcp_memory -"memory/xcp_memory.cmxs": use_xcp_memory -# Library xapi_v6 -"v6/xapi_v6.cmxs": use_xapi_v6 -: pkg_cmdliner -: pkg_cohttp -: pkg_fd-send-recv -: pkg_message_switch -: pkg_message_switch.unix -: pkg_ppx_deriving_rpc -: pkg_ppx_sexp_conv -: pkg_re -: pkg_rpclib -: pkg_rpclib.xml -: pkg_sexplib -: pkg_threads -: pkg_unix -: pkg_uri -: pkg_xapi-backtrace -: pkg_xcp-inventory -: pkg_xmlm -: use_xcp -# Executable channel_helper -: pkg_cmdliner -: pkg_cohttp -: pkg_fd-send-recv -: pkg_lwt -: pkg_lwt.unix -: pkg_message_switch -: pkg_message_switch.unix -: pkg_ppx_deriving_rpc -: pkg_ppx_sexp_conv -: pkg_re -: pkg_rpclib -: pkg_rpclib.xml -: pkg_sexplib -: pkg_threads -: pkg_unix -: pkg_uri -: pkg_xapi-backtrace -: pkg_xcp-inventory -: pkg_xmlm -: use_xcp -: pkg_cmdliner -: pkg_cohttp -: pkg_fd-send-recv -: pkg_lwt -: pkg_lwt.unix -: pkg_message_switch -: pkg_message_switch.unix -: pkg_ppx_deriving_rpc -: pkg_ppx_sexp_conv -: pkg_re -: pkg_rpclib -: pkg_rpclib.xml -: pkg_sexplib -: pkg_threads -: pkg_unix -: pkg_uri -: pkg_xapi-backtrace -: pkg_xcp-inventory -: pkg_xmlm -: use_xcp -: custom -# Executable lib_test -: pkg_cmdliner -: pkg_cohttp -: pkg_fd-send-recv -: pkg_lwt -: pkg_lwt.unix -: pkg_message_switch -: pkg_message_switch.unix -: pkg_oUnit -: pkg_ppx_deriving_rpc -: pkg_ppx_sexp_conv -: pkg_re -: pkg_rpclib -: pkg_rpclib.xml -: pkg_sexplib -: pkg_threads -: pkg_unix -: pkg_uri -: pkg_xapi-backtrace -: pkg_xcp-inventory -: pkg_xmlm -: use_xcp -: use_xcp_updates -: use_xcp_xen -: pkg_cmdliner -: pkg_cohttp -: pkg_fd-send-recv -: pkg_lwt -: pkg_lwt.unix -: pkg_message_switch -: pkg_message_switch.unix -: pkg_oUnit -: pkg_ppx_deriving_rpc -: pkg_ppx_sexp_conv -: pkg_re -: pkg_rpclib -: pkg_rpclib.xml -: pkg_sexplib -: pkg_threads -: pkg_unix -: pkg_uri -: pkg_xapi-backtrace -: pkg_xcp-inventory -: pkg_xmlm -: use_xcp -: use_xcp_updates -: use_xcp_xen -: custom -# Executable example -: pkg_cmdliner -: pkg_cohttp -: pkg_fd-send-recv -: pkg_lwt -: pkg_lwt.unix -: pkg_message_switch -: pkg_message_switch.unix -: pkg_ppx_deriving_rpc -: pkg_ppx_sexp_conv -: pkg_re -: pkg_rpclib -: pkg_rpclib.xml -: pkg_sexplib -: pkg_threads -: pkg_unix -: pkg_uri -: pkg_xapi-backtrace -: pkg_xcp-inventory -: pkg_xmlm -: use_xcp -: pkg_cmdliner -: pkg_cohttp -: pkg_fd-send-recv -: pkg_lwt -: pkg_lwt.unix -: pkg_message_switch -: pkg_message_switch.unix -: pkg_ppx_deriving_rpc -: pkg_ppx_sexp_conv -: pkg_re -: pkg_rpclib -: pkg_rpclib.xml -: pkg_sexplib -: pkg_threads -: pkg_unix -: pkg_uri -: pkg_xapi-backtrace -: pkg_xcp-inventory -: pkg_xmlm -: use_xcp -: custom -# Executable memory_cli -: pkg_cmdliner -: pkg_cohttp -: pkg_fd-send-recv -: pkg_message_switch -: pkg_message_switch.unix -: pkg_ppx_deriving_rpc -: pkg_ppx_sexp_conv -: pkg_re -: pkg_rpclib -: pkg_rpclib.cmdliner -: pkg_rpclib.markdown -: pkg_rpclib.xml -: pkg_sexplib -: pkg_threads -: pkg_unix -: pkg_uri -: pkg_xapi-backtrace -: pkg_xcp-inventory -: pkg_xmlm -: use_xcp -: use_xcp_memory -: pkg_cmdliner -: pkg_cohttp -: pkg_fd-send-recv -: pkg_message_switch -: pkg_message_switch.unix -: pkg_ppx_deriving_rpc -: pkg_ppx_sexp_conv -: pkg_re -: pkg_rpclib -: pkg_rpclib.cmdliner -: pkg_rpclib.markdown -: pkg_rpclib.xml -: pkg_sexplib -: pkg_threads -: pkg_unix -: pkg_uri -: pkg_xapi-backtrace -: pkg_xcp-inventory -: pkg_xmlm -: use_xcp -: use_xcp_memory -# OASIS_STOP -: syntax_camlp4o -: syntax_camlp4o -: syntax_camlp4o -: syntax_camlp4o -: syntax_camlp4o -: pkg_rpclib.idl -: pkg_rpclib.idl -: pkg_rpclib.idl -: pkg_rpclib.idl -: pkg_rpclib.idl -: pkg_rpclib.idl -: pkg_ppx_deriving_rpc diff --git a/example/jbuild b/example/jbuild new file mode 100644 index 00000000..6c0f0e09 --- /dev/null +++ b/example/jbuild @@ -0,0 +1,33 @@ +(* -*- tuareg -*- *) +#require "unix" + +let flags = function +| [] -> "" +| pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" + +let rewriters = ["ppx_deriving_rpc"] +let flags = flags rewriters + +let () = Printf.ksprintf Jbuild_plugin.V1.send {| +(jbuild_version 1) + +(executable + ((name example) + (flags (:standard -w -39 %s)) + (libraries (lwt lwt.unix xcp rpclib)))) + +(alias + ((name runtest) + (deps (example.exe)) + )) +|} flags diff --git a/lib/META b/lib/META deleted file mode 100644 index cb1fd8a8..00000000 --- a/lib/META +++ /dev/null @@ -1,96 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: 8768846be18e97edf6faf163a4fb6e66) -version = "1.2.0" -description = -"Interface definitions and common boilerplate for the xapi toolstack" -requires = -"cmdliner uri re cohttp xmlm unix ppx_sexp_conv sexplib ppx_deriving_rpc rpclib rpclib.xml threads message_switch message_switch.unix fd-send-recv xcp-inventory xapi-backtrace" -archive(byte) = "xcp.cma" -archive(byte, plugin) = "xcp.cma" -archive(native) = "xcp.cmxa" -archive(native, plugin) = "xcp.cmxs" -exists_if = "xcp.cma" -package "xen" ( - version = "1.2.0" - description = - "Interface definitions and common boilerplate for the xapi toolstack" - requires = "xcp threads ppx_deriving_rpc rpclib" - archive(byte) = "xcp_xen.cma" - archive(byte, plugin) = "xcp_xen.cma" - archive(native) = "xcp_xen.cmxa" - archive(native, plugin) = "xcp_xen.cmxs" - exists_if = "xcp_xen.cma" -) - -package "v6" ( - version = "1.2.0" - description = - "Interface definitions and common boilerplate for the xapi toolstack" - requires = "xcp threads rpclib" - archive(byte) = "xapi_v6.cma" - archive(byte, plugin) = "xapi_v6.cma" - archive(native) = "xapi_v6.cmxa" - archive(native, plugin) = "xapi_v6.cmxs" - exists_if = "xapi_v6.cma" -) - -package "updates" ( - version = "1.2.0" - description = - "Interface definitions and common boilerplate for the xapi toolstack" - archive(byte) = "xcp_updates.cma" - archive(byte, plugin) = "xcp_updates.cma" - archive(native) = "xcp_updates.cmxa" - archive(native, plugin) = "xcp_updates.cmxs" - exists_if = "xcp_updates.cma" -) - -package "storage" ( - version = "1.2.0" - description = - "Interface definitions and common boilerplate for the xapi toolstack" - requires = "xcp threads rpclib" - archive(byte) = "xcp_storage.cma" - archive(byte, plugin) = "xcp_storage.cma" - archive(native) = "xcp_storage.cmxa" - archive(native, plugin) = "xcp_storage.cmxs" - exists_if = "xcp_storage.cma" -) - -package "rrd" ( - version = "1.2.0" - description = - "Interface definitions and common boilerplate for the xapi toolstack" - requires = "xcp threads rpclib rrd" - archive(byte) = "xcp_rrd.cma" - archive(byte, plugin) = "xcp_rrd.cma" - archive(native) = "xcp_rrd.cmxa" - archive(native, plugin) = "xcp_rrd.cmxs" - exists_if = "xcp_rrd.cma" -) - -package "network" ( - version = "1.2.0" - description = - "Interface definitions and common boilerplate for the xapi toolstack" - requires = "xcp threads rpclib" - archive(byte) = "xcp_network.cma" - archive(byte, plugin) = "xcp_network.cma" - archive(native) = "xcp_network.cmxa" - archive(native, plugin) = "xcp_network.cmxs" - exists_if = "xcp_network.cma" -) - -package "memory" ( - version = "1.2.0" - description = - "Interface definitions and common boilerplate for the xapi toolstack" - requires = "xcp threads rpclib" - archive(byte) = "xcp_memory.cma" - archive(byte, plugin) = "xcp_memory.cma" - archive(native) = "xcp_memory.cmxa" - archive(native, plugin) = "xcp_memory.cmxs" - exists_if = "xcp_memory.cma" -) -# OASIS_STOP - diff --git a/lib/jbuild b/lib/jbuild new file mode 100644 index 00000000..ea816870 --- /dev/null +++ b/lib/jbuild @@ -0,0 +1,53 @@ +(* -*- tuareg -*- *) +#require "unix" + +let flags = function +| [] -> "" +| pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" + +let rewriters = ["ppx_deriving_rpc"] +let flags = flags rewriters + +let () = Printf.ksprintf Jbuild_plugin.V1.send {| +(jbuild_version 1) + +(library + ((name xcp) + (public_name xcp) + (flags (:standard -w -39 %s)) + (modules (:standard \ updates task_server scheduler channel_helper)) + (c_names (syslog_stubs)) + (libraries (cmdliner uri re cohttp xmlm unix sexplib + ppx_deriving_rpc rpclib rpclib.xml threads message_switch.unix + fd-send-recv xcp-inventory xapi-backtrace)) + (wrapped false))) + +(library + ((name xcp_updates) + (public_name xcp.updates) + (flags (:standard -w -39 %s)) + (modules (updates task_server scheduler)) + (libraries (xcp lwt)) + (wrapped false))) + +(executable + ((name channel_helper) + (flags (:standard -w -39 %s)) + (modules (channel_helper)) + (libraries (xcp lwt lwt.unix cmdliner)))) + +(alias + ((name runtest) + (deps (channel_helper.exe)))) + +|} flags flags flags diff --git a/lib/xcp.mldylib b/lib/xcp.mldylib deleted file mode 100644 index 2e78dc2b..00000000 --- a/lib/xcp.mldylib +++ /dev/null @@ -1,12 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: 8f2eafbdb1237c9801209b285712e001) -Cohttp_posix_io -Posix_channel -Open_uri -Xcp_client -Xcp_service -Xcp_channel -Xcp_channel_protocol -Syslog -Debug -# OASIS_STOP diff --git a/lib/xcp.mllib b/lib/xcp.mllib deleted file mode 100644 index 2e78dc2b..00000000 --- a/lib/xcp.mllib +++ /dev/null @@ -1,12 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: 8f2eafbdb1237c9801209b285712e001) -Cohttp_posix_io -Posix_channel -Open_uri -Xcp_client -Xcp_service -Xcp_channel -Xcp_channel_protocol -Syslog -Debug -# OASIS_STOP diff --git a/lib/xcp_updates.mldylib b/lib/xcp_updates.mldylib deleted file mode 100644 index 1db6e5c8..00000000 --- a/lib/xcp_updates.mldylib +++ /dev/null @@ -1,6 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: dd7f637b2f33ebc03eb0592cb7851c5f) -Updates -Task_server -Scheduler -# OASIS_STOP diff --git a/lib/xcp_updates.mllib b/lib/xcp_updates.mllib deleted file mode 100644 index 1db6e5c8..00000000 --- a/lib/xcp_updates.mllib +++ /dev/null @@ -1,6 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: dd7f637b2f33ebc03eb0592cb7851c5f) -Updates -Task_server -Scheduler -# OASIS_STOP diff --git a/lib_test/jbuild b/lib_test/jbuild new file mode 100644 index 00000000..26e3234a --- /dev/null +++ b/lib_test/jbuild @@ -0,0 +1,34 @@ +(* -*- tuareg -*- *) +#require "unix" + +let flags = function +| [] -> "" +| pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" + +let rewriters = ["ppx_deriving_rpc"; "ppx_sexp_conv"] +let flags = flags rewriters + +let () = Printf.ksprintf Jbuild_plugin.V1.send {| +(jbuild_version 1) + +(executable + ((name test) + (flags (:standard -w -39 %s)) + (libraries (lwt lwt.unix xcp xcp.xen threads rpclib oUnit xcp.updates)))) + +(alias + ((name runtest) + (deps (test.exe)) + (action (run ${<} -runner sequential)))) + +|} flags diff --git a/memory/jbuild b/memory/jbuild new file mode 100644 index 00000000..96099a6a --- /dev/null +++ b/memory/jbuild @@ -0,0 +1,41 @@ +(* -*- tuareg -*- *) +#require "unix" + +let flags = function +| [] -> "" +| pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" + +let rewriters = ["ppx_deriving_rpc"] +let flags = flags rewriters + +let () = Printf.ksprintf Jbuild_plugin.V1.send {| +(jbuild_version 1) + +(library + ((name xcp_memory) + (public_name xcp.memory) + (flags (:standard -w -39 %s)) + (modules (:standard \ memory_cli)) + (libraries (xcp threads rpclib)) + (wrapped false))) + +(executable + ((name memory_cli) + (modules (memory_cli)) + (libraries (xcp.memory cmdliner rpclib.cmdliner rpclib.markdown)))) + +(alias + ((name runtest) + (deps (memory_cli.exe)))) + +|} flags diff --git a/memory/xcp_memory.mldylib b/memory/xcp_memory.mldylib deleted file mode 100644 index f5e402fc..00000000 --- a/memory/xcp_memory.mldylib +++ /dev/null @@ -1,5 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: 0c70f6173351a59554009fa9733b9750) -Memory_interface -Memory_client -# OASIS_STOP diff --git a/memory/xcp_memory.mllib b/memory/xcp_memory.mllib deleted file mode 100644 index f5e402fc..00000000 --- a/memory/xcp_memory.mllib +++ /dev/null @@ -1,5 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: 0c70f6173351a59554009fa9733b9750) -Memory_interface -Memory_client -# OASIS_STOP diff --git a/myocamlbuild.ml b/myocamlbuild.ml deleted file mode 100644 index 8b551df5..00000000 --- a/myocamlbuild.ml +++ /dev/null @@ -1,915 +0,0 @@ -(* OASIS_START *) -(* DO NOT EDIT (digest: 208fc8f3d41ce26e150480e18457ec7a) *) -module OASISGettext = struct -(* # 22 "src/oasis/OASISGettext.ml" *) - - - let ns_ str = str - let s_ str = str - let f_ (str: ('a, 'b, 'c, 'd) format4) = str - - - let fn_ fmt1 fmt2 n = - if n = 1 then - fmt1^^"" - else - fmt2^^"" - - - let init = [] -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; - !what_idx = String.length what - - - 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; - !what_idx = -1 - - - 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 OASISUtils = struct -(* # 22 "src/oasis/OASISUtils.ml" *) - - - open OASISGettext - - - module MapExt = - struct - module type S = - sig - include Map.S - val add_list: 'a t -> (key * 'a) list -> 'a t - val of_list: (key * 'a) list -> 'a t - val to_list: 'a t -> (key * 'a) list - end - - module Make (Ord: Map.OrderedType) = - struct - include Map.Make(Ord) - - let rec add_list t = - function - | (k, v) :: tl -> add_list (add k v t) tl - | [] -> t - - let of_list lst = add_list empty lst - - let to_list t = fold (fun k v acc -> (k, v) :: acc) t [] - end - end - - - module MapString = MapExt.Make(String) - - - module SetExt = - struct - module type S = - sig - include Set.S - val add_list: t -> elt list -> t - val of_list: elt list -> t - val to_list: t -> elt list - end - - module Make (Ord: Set.OrderedType) = - struct - include Set.Make(Ord) - - let rec add_list t = - function - | e :: tl -> add_list (add e t) tl - | [] -> t - - let of_list lst = add_list empty lst - - let to_list = elements - end - end - - - module SetString = SetExt.Make(String) - - - let compare_csl s1 s2 = - String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2) - - - module HashStringCsl = - Hashtbl.Make - (struct - type t = string - let equal s1 s2 = (compare_csl s1 s2) = 0 - let hash s = Hashtbl.hash (OASISString.lowercase_ascii s) - end) - - module SetStringCsl = - SetExt.Make - (struct - type t = string - let compare = compare_csl - end) - - - let varname_of_string ?(hyphen='_') s = - if String.length s = 0 then - begin - invalid_arg "varname_of_string" - end - else - begin - let buf = - OASISString.replace_chars - (fun c -> - if ('a' <= c && c <= 'z') - || - ('A' <= c && c <= 'Z') - || - ('0' <= c && c <= '9') then - c - else - hyphen) - s; - in - let buf = - (* Start with a _ if digit *) - if '0' <= s.[0] && s.[0] <= '9' then - "_"^buf - else - buf - in - OASISString.lowercase_ascii buf - end - - - let varname_concat ?(hyphen='_') p s = - let what = String.make 1 hyphen in - let p = - try - OASISString.strip_ends_with ~what p - with Not_found -> - p - in - let s = - try - OASISString.strip_starts_with ~what s - with Not_found -> - s - in - p^what^s - - - let is_varname str = - str = varname_of_string str - - - let failwithf fmt = Printf.ksprintf failwith fmt - - - let rec file_location ?pos1 ?pos2 ?lexbuf () = - match pos1, pos2, lexbuf with - | Some p, None, _ | None, Some p, _ -> - file_location ~pos1:p ~pos2:p ?lexbuf () - | Some p1, Some p2, _ -> - let open Lexing in - let fn, lineno = p1.pos_fname, p1.pos_lnum in - let c1 = p1.pos_cnum - p1.pos_bol in - let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in - Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2 - | _, _, Some lexbuf -> - file_location - ~pos1:(Lexing.lexeme_start_p lexbuf) - ~pos2:(Lexing.lexeme_end_p lexbuf) - () - | None, None, None -> - s_ "" - - - let failwithpf ?pos1 ?pos2 ?lexbuf fmt = - let loc = file_location ?pos1 ?pos2 ?lexbuf () in - Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt - - -end - -module OASISExpr = struct -(* # 22 "src/oasis/OASISExpr.ml" *) - - - open OASISGettext - open OASISUtils - - - type test = string - type flag = string - - - type t = - | EBool of bool - | ENot of t - | EAnd of t * t - | EOr of t * t - | EFlag of flag - | ETest of test * string - - - type 'a choices = (t * 'a) list - - - let eval var_get t = - let rec eval' = - function - | EBool b -> - b - - | ENot e -> - not (eval' e) - - | EAnd (e1, e2) -> - (eval' e1) && (eval' e2) - - | EOr (e1, e2) -> - (eval' e1) || (eval' e2) - - | EFlag nm -> - let v = - var_get nm - in - assert(v = "true" || v = "false"); - (v = "true") - - | ETest (nm, vl) -> - let v = - var_get nm - in - (v = vl) - in - eval' t - - - let choose ?printer ?name var_get lst = - let rec choose_aux = - function - | (cond, vl) :: tl -> - if eval var_get cond then - vl - else - choose_aux tl - | [] -> - let str_lst = - if lst = [] then - s_ "" - else - String.concat - (s_ ", ") - (List.map - (fun (cond, vl) -> - match printer with - | Some p -> p vl - | None -> s_ "") - lst) - in - match name with - | Some nm -> - failwith - (Printf.sprintf - (f_ "No result for the choice list '%s': %s") - nm str_lst) - | None -> - failwith - (Printf.sprintf - (f_ "No result for a choice list: %s") - str_lst) - in - choose_aux (List.rev lst) - - -end - - -# 437 "myocamlbuild.ml" -module BaseEnvLight = struct -(* # 22 "src/base/BaseEnvLight.ml" *) - - - module MapString = Map.Make(String) - - - type t = string MapString.t - - - let default_filename = Filename.concat (Sys.getcwd ()) "setup.data" - - - let load ?(allow_empty=false) ?(filename=default_filename) ?stream () = - let line = ref 1 in - let lexer st = - let st_line = - Stream.from - (fun _ -> - try - match Stream.next st with - | '\n' -> incr line; Some '\n' - | c -> Some c - with Stream.Failure -> None) - in - Genlex.make_lexer ["="] st_line - in - let rec read_file lxr mp = - match Stream.npeek 3 lxr with - | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> - Stream.junk lxr; Stream.junk lxr; Stream.junk lxr; - read_file lxr (MapString.add nm value mp) - | [] -> mp - | _ -> - failwith - (Printf.sprintf "Malformed data file '%s' line %d" filename !line) - in - match stream with - | Some st -> read_file (lexer st) MapString.empty - | None -> - if Sys.file_exists filename then begin - let chn = open_in_bin filename in - let st = Stream.of_channel chn in - try - let mp = read_file (lexer st) MapString.empty in - close_in chn; mp - with e -> - close_in chn; raise e - end else if allow_empty then begin - MapString.empty - end else begin - failwith - (Printf.sprintf - "Unable to load environment, the file '%s' doesn't exist." - filename) - end - - let rec var_expand str env = - let buff = Buffer.create ((String.length str) * 2) in - Buffer.add_substitute - buff - (fun var -> - try - var_expand (MapString.find var env) env - with Not_found -> - failwith - (Printf.sprintf - "No variable %s defined when trying to expand %S." - var - str)) - str; - Buffer.contents buff - - - let var_get name env = var_expand (MapString.find name env) env - let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst -end - - -# 517 "myocamlbuild.ml" -module MyOCamlbuildFindlib = struct -(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *) - - - (** OCamlbuild extension, copied from - * https://ocaml.org/learn/tutorials/ocamlbuild/Using_ocamlfind_with_ocamlbuild.html - * by N. Pouillard and others - * - * Updated on 2016-06-02 - * - * Modified by Sylvain Le Gall - *) - open Ocamlbuild_plugin - - - type conf = {no_automatic_syntax: bool} - - - let run_and_read = Ocamlbuild_pack.My_unix.run_and_read - - - let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings - - - let exec_from_conf exec = - let exec = - let env = BaseEnvLight.load ~allow_empty:true () in - try - BaseEnvLight.var_get exec env - with Not_found -> - Printf.eprintf "W: Cannot get variable %s\n" exec; - exec - in - let fix_win32 str = - if Sys.os_type = "Win32" then begin - let buff = Buffer.create (String.length str) in - (* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'. - *) - String.iter - (fun c -> Buffer.add_char buff (if c = '\\' then '/' else c)) - str; - Buffer.contents buff - end else begin - str - end - in - fix_win32 exec - - - let split s ch = - let buf = Buffer.create 13 in - let x = ref [] in - let flush () = - x := (Buffer.contents buf) :: !x; - Buffer.clear buf - in - String.iter - (fun c -> - if c = ch then - flush () - else - Buffer.add_char buf c) - s; - flush (); - List.rev !x - - - let split_nl s = split s '\n' - - - let before_space s = - try - String.before s (String.index s ' ') - with Not_found -> s - - (* ocamlfind command *) - let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x] - - (* This lists all supported packages. *) - let find_packages () = - List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list")) - - - (* Mock to list available syntaxes. *) - let find_syntaxes () = ["camlp4o"; "camlp4r"] - - - let well_known_syntax = [ - "camlp4.quotations.o"; - "camlp4.quotations.r"; - "camlp4.exceptiontracer"; - "camlp4.extend"; - "camlp4.foldgenerator"; - "camlp4.listcomprehension"; - "camlp4.locationstripper"; - "camlp4.macro"; - "camlp4.mapgenerator"; - "camlp4.metagenerator"; - "camlp4.profiler"; - "camlp4.tracer" - ] - - - let dispatch conf = - function - | After_options -> - (* By using Before_options one let command line options have an higher - * priority on the contrary using After_options will guarantee to have - * the higher priority override default commands by ocamlfind ones *) - Options.ocamlc := ocamlfind & A"ocamlc"; - Options.ocamlopt := ocamlfind & A"ocamlopt"; - Options.ocamldep := ocamlfind & A"ocamldep"; - Options.ocamldoc := ocamlfind & A"ocamldoc"; - Options.ocamlmktop := ocamlfind & A"ocamlmktop"; - Options.ocamlmklib := ocamlfind & A"ocamlmklib" - - | After_rules -> - - (* Avoid warnings for unused tag *) - flag ["tests"] N; - - (* When one link an OCaml library/binary/package, one should use - * -linkpkg *) - flag ["ocaml"; "link"; "program"] & A"-linkpkg"; - - (* For each ocamlfind package one inject the -package option when - * compiling, computing dependencies, generating documentation and - * linking. *) - List.iter - begin fun pkg -> - let base_args = [A"-package"; A pkg] in - (* TODO: consider how to really choose camlp4o or camlp4r. *) - let syn_args = [A"-syntax"; A "camlp4o"] in - let (args, pargs) = - (* Heuristic to identify syntax extensions: whether they end in - ".syntax"; some might not. - *) - if not (conf.no_automatic_syntax) && - (Filename.check_suffix pkg "syntax" || - List.mem pkg well_known_syntax) then - (syn_args @ base_args, syn_args) - else - (base_args, []) - in - flag ["ocaml"; "compile"; "pkg_"^pkg] & S args; - flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args; - flag ["ocaml"; "doc"; "pkg_"^pkg] & S args; - flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args; - flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args; - - (* TODO: Check if this is allowed for OCaml < 3.12.1 *) - flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs; - flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs; - flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs; - flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs; - end - (find_packages ()); - - (* Like -package but for extensions syntax. Morover -syntax is useless - * when linking. *) - List.iter begin fun syntax -> - flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; - flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; - flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; - flag ["ocaml"; "infer_interface"; "syntax_"^syntax] & - S[A"-syntax"; A syntax]; - end (find_syntaxes ()); - - (* The default "thread" tag is not compatible with ocamlfind. - * Indeed, the default rules add the "threads.cma" or "threads.cmxa" - * options when using this tag. When using the "-linkpkg" option with - * ocamlfind, this module will then be added twice on the command line. - * - * To solve this, one approach is to add the "-thread" option when using - * the "threads" package using the previous plugin. - *) - flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]); - flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]); - flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]); - flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]); - flag ["c"; "pkg_threads"; "compile"] (S[A "-thread"]); - flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]); - flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]); - flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]); - flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]); - flag ["c"; "package(threads)"; "compile"] (S[A "-thread"]); - - | _ -> - () -end - -module MyOCamlbuildBase = struct -(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) - - - (** Base functions for writing myocamlbuild.ml - @author Sylvain Le Gall - *) - - - open Ocamlbuild_plugin - module OC = Ocamlbuild_pack.Ocaml_compiler - - - type dir = string - type file = string - type name = string - type tag = string - - - type t = - { - lib_ocaml: (name * dir list * string list) list; - lib_c: (name * dir * file list) list; - flags: (tag list * (spec OASISExpr.choices)) list; - (* Replace the 'dir: include' from _tags by a precise interdepends in - * directory. - *) - includes: (dir * dir list) list; - } - - -(* # 110 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) - - - let env_filename = Pathname.basename BaseEnvLight.default_filename - - - let dispatch_combine lst = - fun e -> - List.iter - (fun dispatch -> dispatch e) - lst - - - let tag_libstubs nm = - "use_lib"^nm^"_stubs" - - - let nm_libstubs nm = - nm^"_stubs" - - - let dispatch t e = - let env = BaseEnvLight.load ~allow_empty:true () in - match e with - | Before_options -> - let no_trailing_dot s = - if String.length s >= 1 && s.[0] = '.' then - String.sub s 1 ((String.length s) - 1) - else - s - in - List.iter - (fun (opt, var) -> - try - opt := no_trailing_dot (BaseEnvLight.var_get var env) - with Not_found -> - Printf.eprintf "W: Cannot get variable %s\n" var) - [ - Options.ext_obj, "ext_obj"; - Options.ext_lib, "ext_lib"; - Options.ext_dll, "ext_dll"; - ] - - | After_rules -> - (* Declare OCaml libraries *) - List.iter - (function - | nm, [], intf_modules -> - ocaml_lib nm; - let cmis = - 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 -> - ocaml_lib ~dir:dir (dir^"/"^nm); - List.iter - (fun dir -> - List.iter - (fun str -> - flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir])) - ["compile"; "infer_interface"; "doc"]) - tl; - let cmis = - List.map (fun m -> dir^"/"^(OASISString.uncapitalize_ascii m)^".cmi") - intf_modules in - dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"] - cmis) - t.lib_ocaml; - - (* Declare directories dependencies, replace "include" in _tags. *) - List.iter - (fun (dir, include_dirs) -> - Pathname.define_context dir include_dirs) - t.includes; - - (* Declare C libraries *) - List.iter - (fun (lib, dir, headers) -> - (* Handle C part of library *) - flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib] - (S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib"; - A("-l"^(nm_libstubs lib))]); - - flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib] - (S[A"-cclib"; A("-l"^(nm_libstubs lib))]); - - if bool_of_string (BaseEnvLight.var_get "native_dynlink" env) then - flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib] - (S[A"-dllib"; A("dll"^(nm_libstubs lib))]); - - (* When ocaml link something that use the C library, then one - need that file to be up to date. - This holds both for programs and for libraries. - *) - dep ["link"; "ocaml"; tag_libstubs lib] - [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; - - dep ["compile"; "ocaml"; tag_libstubs lib] - [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; - - (* TODO: be more specific about what depends on headers *) - (* Depends on .h files *) - dep ["compile"; "c"] - headers; - - (* Setup search path for lib *) - flag ["link"; "ocaml"; "use_"^lib] - (S[A"-I"; P(dir)]); - ) - t.lib_c; - - (* Add flags *) - List.iter - (fun (tags, cond_specs) -> - let spec = BaseEnvLight.var_choose cond_specs env in - let rec eval_specs = - function - | S lst -> S (List.map eval_specs lst) - | A str -> A (BaseEnvLight.var_expand str env) - | spec -> spec - in - flag tags & (eval_specs spec)) - t.flags - | _ -> - () - - - let dispatch_default conf t = - dispatch_combine - [ - dispatch t; - MyOCamlbuildFindlib.dispatch conf; - ] - - -end - - -# 878 "myocamlbuild.ml" -open Ocamlbuild_plugin;; -let package_default = - { - MyOCamlbuildBase.lib_ocaml = - [ - ("xcp", ["lib"], []); - ("xcp_updates", ["lib"], []); - ("xcp_storage", ["storage"], []); - ("xcp_network", ["network"], []); - ("xcp_rrd", ["rrd"], []); - ("xcp_xen", ["xen"], []); - ("xcp_memory", ["memory"], []); - ("xapi_v6", ["v6"], []) - ]; - lib_c = [("xcp", "lib", [])]; - flags = []; - includes = - [ - ("xen", ["lib"]); - ("v6", ["lib"]); - ("storage", ["lib"]); - ("rrd", ["lib"]); - ("network", ["lib"]); - ("memory", ["lib"]); - ("lib_test", ["lib"; "xen"]); - ("example", ["lib"]) - ] - } - ;; - -let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} - -let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; - -# 914 "myocamlbuild.ml" -(* OASIS_STOP *) -Ocamlbuild_plugin.dispatch dispatch_default;; diff --git a/network/jbuild b/network/jbuild new file mode 100644 index 00000000..b28e7f99 --- /dev/null +++ b/network/jbuild @@ -0,0 +1,40 @@ +(* -*- tuareg -*- *) +#require "unix" + +let flags = function +| [] -> "" +| pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" + +let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"] +let rewriters_ppx = ["ppx_deriving_rpc"; "ppx_sexp_conv"] + +let () = Printf.ksprintf Jbuild_plugin.V1.send {| +(jbuild_version 1) + +(library + ((name xcp_network_interface) + (public_name xcp.network.interface) + (modules (network_interface)) + (flags (:standard -w -39 %s)) + (libraries (xcp threads rpclib)) + (wrapped false))) + +(library + ((name xcp_network) + (public_name xcp.network) + (modules (:standard \ network_interface)) + (flags (:standard -w -39-33 %s)) + (libraries (xcp threads rpclib xcp_network_interface)) + (wrapped false))) + +|} (flags rewriters_camlp4) (flags rewriters_ppx) diff --git a/network/xcp_network.mldylib b/network/xcp_network.mldylib deleted file mode 100644 index 2a8d759c..00000000 --- a/network/xcp_network.mldylib +++ /dev/null @@ -1,6 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: d598dc0e90da1e8fcfc70e267713f9c5) -Network_interface -Network_client -Network_stats -# OASIS_STOP diff --git a/network/xcp_network.mllib b/network/xcp_network.mllib deleted file mode 100644 index 2a8d759c..00000000 --- a/network/xcp_network.mllib +++ /dev/null @@ -1,6 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: d598dc0e90da1e8fcfc70e267713f9c5) -Network_interface -Network_client -Network_stats -# OASIS_STOP diff --git a/rrd/jbuild b/rrd/jbuild new file mode 100644 index 00000000..8da662d0 --- /dev/null +++ b/rrd/jbuild @@ -0,0 +1,47 @@ +(* -*- tuareg -*- *) +#require "unix" + +let flags = function +| [] -> "" +| pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" + +let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"] +let rewriters_ppx = ["ppx_deriving_rpc"] + +let () = Printf.ksprintf Jbuild_plugin.V1.send {| +(jbuild_version 1) + +(library + ((name xcp_rrd_interface_types) + (public_name xcp.rrd.interface.types) + (modules (data_source)) + (flags (:standard -w -39 %s)) + (libraries (xcp threads rpclib rrd)) + (wrapped false))) + +(library + ((name xcp_rrd_interface) + (public_name xcp.rrd.interface) + (modules (rrd_interface)) + (flags (:standard -w -39 %s)) + (libraries (xcp threads rpclib rrd xcp_rrd_interface_types)) + (wrapped false))) + +(library + ((name xcp_rrd) + (public_name xcp.rrd) + (modules (:standard \ rrd_interface data_source)) + (flags (:standard -w -39 %s)) + (libraries (xcp threads rpclib rrd xcp_rrd_interface)) + (wrapped false))) +|} (flags rewriters_ppx) (flags rewriters_camlp4) (flags rewriters_ppx) diff --git a/rrd/xcp_rrd.mldylib b/rrd/xcp_rrd.mldylib deleted file mode 100644 index 457d77e2..00000000 --- a/rrd/xcp_rrd.mldylib +++ /dev/null @@ -1,7 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: 0e52165fc9813a3cf8ee1ec6e1dbb809) -Data_source -Ds -Rrd_interface -Rrd_client -# OASIS_STOP diff --git a/rrd/xcp_rrd.mllib b/rrd/xcp_rrd.mllib deleted file mode 100644 index 457d77e2..00000000 --- a/rrd/xcp_rrd.mllib +++ /dev/null @@ -1,7 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: 0e52165fc9813a3cf8ee1ec6e1dbb809) -Data_source -Ds -Rrd_interface -Rrd_client -# OASIS_STOP diff --git a/setup.ml b/setup.ml deleted file mode 100644 index ae0beb88..00000000 --- a/setup.ml +++ /dev/null @@ -1,9058 +0,0 @@ -(* setup.ml generated for the first time by OASIS v0.3.1 *) - -(* OASIS_START *) -(* DO NOT EDIT (digest: 5792256a2dd76a42cf85e44bcd6f0124) *) -(* - Regenerated by OASIS v0.4.10 - Visit http://oasis.forge.ocamlcore.org for more information and - documentation about functions used in this file. -*) -module OASISGettext = struct -(* # 22 "src/oasis/OASISGettext.ml" *) - - - let ns_ str = str - let s_ str = str - let f_ (str: ('a, 'b, 'c, 'd) format4) = str - - - let fn_ fmt1 fmt2 n = - if n = 1 then - fmt1^^"" - else - fmt2^^"" - - - let init = [] -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; - !what_idx = String.length what - - - 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; - !what_idx = -1 - - - 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 OASISUtils = struct -(* # 22 "src/oasis/OASISUtils.ml" *) - - - open OASISGettext - - - module MapExt = - struct - module type S = - sig - include Map.S - val add_list: 'a t -> (key * 'a) list -> 'a t - val of_list: (key * 'a) list -> 'a t - val to_list: 'a t -> (key * 'a) list - end - - module Make (Ord: Map.OrderedType) = - struct - include Map.Make(Ord) - - let rec add_list t = - function - | (k, v) :: tl -> add_list (add k v t) tl - | [] -> t - - let of_list lst = add_list empty lst - - let to_list t = fold (fun k v acc -> (k, v) :: acc) t [] - end - end - - - module MapString = MapExt.Make(String) - - - module SetExt = - struct - module type S = - sig - include Set.S - val add_list: t -> elt list -> t - val of_list: elt list -> t - val to_list: t -> elt list - end - - module Make (Ord: Set.OrderedType) = - struct - include Set.Make(Ord) - - let rec add_list t = - function - | e :: tl -> add_list (add e t) tl - | [] -> t - - let of_list lst = add_list empty lst - - let to_list = elements - end - end - - - module SetString = SetExt.Make(String) - - - let compare_csl s1 s2 = - String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2) - - - module HashStringCsl = - Hashtbl.Make - (struct - type t = string - let equal s1 s2 = (compare_csl s1 s2) = 0 - let hash s = Hashtbl.hash (OASISString.lowercase_ascii s) - end) - - module SetStringCsl = - SetExt.Make - (struct - type t = string - let compare = compare_csl - end) - - - let varname_of_string ?(hyphen='_') s = - if String.length s = 0 then - begin - invalid_arg "varname_of_string" - end - else - begin - let buf = - OASISString.replace_chars - (fun c -> - if ('a' <= c && c <= 'z') - || - ('A' <= c && c <= 'Z') - || - ('0' <= c && c <= '9') then - c - else - hyphen) - s; - in - let buf = - (* Start with a _ if digit *) - if '0' <= s.[0] && s.[0] <= '9' then - "_"^buf - else - buf - in - OASISString.lowercase_ascii buf - end - - - let varname_concat ?(hyphen='_') p s = - let what = String.make 1 hyphen in - let p = - try - OASISString.strip_ends_with ~what p - with Not_found -> - p - in - let s = - try - OASISString.strip_starts_with ~what s - with Not_found -> - s - in - p^what^s - - - let is_varname str = - str = varname_of_string str - - - let failwithf fmt = Printf.ksprintf failwith fmt - - - let rec file_location ?pos1 ?pos2 ?lexbuf () = - match pos1, pos2, lexbuf with - | Some p, None, _ | None, Some p, _ -> - file_location ~pos1:p ~pos2:p ?lexbuf () - | Some p1, Some p2, _ -> - let open Lexing in - let fn, lineno = p1.pos_fname, p1.pos_lnum in - let c1 = p1.pos_cnum - p1.pos_bol in - let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in - Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2 - | _, _, Some lexbuf -> - file_location - ~pos1:(Lexing.lexeme_start_p lexbuf) - ~pos2:(Lexing.lexeme_end_p lexbuf) - () - | None, None, None -> - s_ "" - - - let failwithpf ?pos1 ?pos2 ?lexbuf fmt = - let loc = file_location ?pos1 ?pos2 ?lexbuf () in - Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt - - -end - -module OASISUnixPath = struct -(* # 22 "src/oasis/OASISUnixPath.ml" *) - - - type unix_filename = string - type unix_dirname = string - - - type host_filename = string - type host_dirname = string - - - let current_dir_name = "." - - - let parent_dir_name = ".." - - - let is_current_dir fn = - fn = current_dir_name || fn = "" - - - let concat f1 f2 = - if is_current_dir f1 then - f2 - else - let f1' = - try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1 - in - f1'^"/"^f2 - - - let make = - function - | hd :: tl -> - List.fold_left - (fun f p -> concat f p) - hd - tl - | [] -> - invalid_arg "OASISUnixPath.make" - - - let dirname f = - try - String.sub f 0 (String.rindex f '/') - with Not_found -> - current_dir_name - - - let basename f = - try - let pos_start = - (String.rindex f '/') + 1 - in - String.sub f pos_start ((String.length f) - pos_start) - with Not_found -> - f - - - let chop_extension f = - try - let last_dot = - String.rindex f '.' - in - let sub = - String.sub f 0 last_dot - in - try - let last_slash = - String.rindex f '/' - in - if last_slash < last_dot then - sub - else - f - with Not_found -> - sub - - with Not_found -> - f - - - let capitalize_file f = - let dir = dirname f in - let base = basename f in - concat dir (OASISString.capitalize_ascii base) - - - let uncapitalize_file f = - let dir = dirname f in - let base = basename f in - concat dir (OASISString.uncapitalize_ascii base) - - -end - -module OASISHostPath = struct -(* # 22 "src/oasis/OASISHostPath.ml" *) - - - open Filename - open OASISGettext - - - module Unix = OASISUnixPath - - - let make = - function - | [] -> - invalid_arg "OASISHostPath.make" - | hd :: tl -> - List.fold_left Filename.concat hd tl - - - let of_unix ufn = - match Sys.os_type with - | "Unix" | "Cygwin" -> ufn - | "Win32" -> - make - (List.map - (fun p -> - if p = Unix.current_dir_name then - current_dir_name - else if p = Unix.parent_dir_name then - parent_dir_name - else - p) - (OASISString.nsplit ufn '/')) - | os_type -> - OASISUtils.failwithf - (f_ "Don't know the path format of os_type %S when translating unix \ - filename. %S") - os_type ufn - - -end - -module OASISFileSystem = struct -(* # 22 "src/oasis/OASISFileSystem.ml" *) - - (** File System functions - - @author Sylvain Le Gall - *) - - type 'a filename = string - - class type closer = - object - method close: unit - end - - class type reader = - object - inherit closer - method input: Buffer.t -> int -> unit - end - - class type writer = - object - inherit closer - method output: Buffer.t -> unit - end - - class type ['a] fs = - object - method string_of_filename: 'a filename -> string - method open_out: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> writer - method open_in: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> reader - method file_exists: 'a filename -> bool - method remove: 'a filename -> unit - end - - - module Mode = - struct - let default_in = [Open_rdonly] - let default_out = [Open_wronly; Open_creat; Open_trunc] - - let text_in = Open_text :: default_in - let text_out = Open_text :: default_out - - let binary_in = Open_binary :: default_in - let binary_out = Open_binary :: default_out - end - - let std_length = 4096 (* Standard buffer/read length. *) - let binary_out = Mode.binary_out - let binary_in = Mode.binary_in - - let of_unix_filename ufn = (ufn: 'a filename) - let to_unix_filename fn = (fn: string) - - - let defer_close o f = - try - let r = f o in o#close; r - with e -> - o#close; raise e - - - let stream_of_reader rdr = - let buf = Buffer.create std_length in - let pos = ref 0 in - let eof = ref false in - let rec next idx = - let bpos = idx - !pos in - if !eof then begin - None - end else if bpos < Buffer.length buf then begin - Some (Buffer.nth buf bpos) - end else begin - pos := !pos + Buffer.length buf; - Buffer.clear buf; - begin - try - rdr#input buf std_length; - with End_of_file -> - if Buffer.length buf = 0 then - eof := true - end; - next idx - end - in - Stream.from next - - - let read_all buf rdr = - try - while true do - rdr#input buf std_length - done - with End_of_file -> - () - - class ['a] host_fs rootdir : ['a] fs = - object (self) - method private host_filename fn = Filename.concat rootdir fn - method string_of_filename = self#host_filename - - method open_out ?(mode=Mode.text_out) ?(perm=0o666) fn = - let chn = open_out_gen mode perm (self#host_filename fn) in - object - method close = close_out chn - method output buf = Buffer.output_buffer chn buf - end - - method open_in ?(mode=Mode.text_in) ?(perm=0o666) fn = - (* TODO: use Buffer.add_channel when minimal version of OCaml will - * be >= 4.03.0 (previous version was discarding last chars). - *) - let chn = open_in_gen mode perm (self#host_filename fn) in - let strm = Stream.of_channel chn in - object - method close = close_in chn - method input buf len = - let read = ref 0 in - try - for _i = 0 to len do - Buffer.add_char buf (Stream.next strm); - incr read - done - with Stream.Failure -> - if !read = 0 then - raise End_of_file - end - - method file_exists fn = Sys.file_exists (self#host_filename fn) - method remove fn = Sys.remove (self#host_filename fn) - end - -end - -module OASISContext = struct -(* # 22 "src/oasis/OASISContext.ml" *) - - - open OASISGettext - - - type level = - [ `Debug - | `Info - | `Warning - | `Error] - - - type source - type source_filename = source OASISFileSystem.filename - - - let in_srcdir ufn = OASISFileSystem.of_unix_filename ufn - - - type t = - { - (* TODO: replace this by a proplist. *) - quiet: bool; - info: bool; - debug: bool; - ignore_plugins: bool; - ignore_unknown_fields: bool; - printf: level -> string -> unit; - srcfs: source OASISFileSystem.fs; - load_oasis_plugin: string -> bool; - } - - - let printf lvl str = - let beg = - match lvl with - | `Error -> s_ "E: " - | `Warning -> s_ "W: " - | `Info -> s_ "I: " - | `Debug -> s_ "D: " - in - prerr_endline (beg^str) - - - let default = - ref - { - quiet = false; - info = false; - debug = false; - ignore_plugins = false; - ignore_unknown_fields = false; - printf = printf; - srcfs = new OASISFileSystem.host_fs(Sys.getcwd ()); - load_oasis_plugin = (fun _ -> false); - } - - - let quiet = - {!default with quiet = true} - - - let fspecs () = - (* TODO: don't act on default. *) - let ignore_plugins = ref false in - ["-quiet", - Arg.Unit (fun () -> default := {!default with quiet = true}), - s_ " Run quietly"; - - "-info", - Arg.Unit (fun () -> default := {!default with info = true}), - s_ " Display information message"; - - - "-debug", - Arg.Unit (fun () -> default := {!default with debug = true}), - s_ " Output debug message"; - - "-ignore-plugins", - Arg.Set ignore_plugins, - s_ " Ignore plugin's field."; - - "-C", - Arg.String - (fun str -> - Sys.chdir str; - default := {!default with srcfs = new OASISFileSystem.host_fs str}), - s_ "dir Change directory before running (affects setup.{data,log})."], - fun () -> {!default with ignore_plugins = !ignore_plugins} -end - -module PropList = struct -(* # 22 "src/oasis/PropList.ml" *) - - - open OASISGettext - - - type name = string - - - exception Not_set of name * string option - exception No_printer of name - exception Unknown_field of name * name - - - let () = - Printexc.register_printer - (function - | Not_set (nm, Some rsn) -> - Some - (Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn) - | Not_set (nm, None) -> - Some - (Printf.sprintf (f_ "Field '%s' is not set") nm) - | No_printer nm -> - Some - (Printf.sprintf (f_ "No default printer for value %s") nm) - | Unknown_field (nm, schm) -> - Some - (Printf.sprintf - (f_ "Field %s is not defined in schema %s") nm schm) - | _ -> - None) - - - module Data = - struct - type t = - (name, unit -> unit) Hashtbl.t - - let create () = - Hashtbl.create 13 - - let clear t = - Hashtbl.clear t - - -(* # 77 "src/oasis/PropList.ml" *) - end - - - module Schema = - struct - type ('ctxt, 'extra) value = - { - get: Data.t -> string; - set: Data.t -> ?context:'ctxt -> string -> unit; - help: (unit -> string) option; - extra: 'extra; - } - - type ('ctxt, 'extra) t = - { - name: name; - fields: (name, ('ctxt, 'extra) value) Hashtbl.t; - order: name Queue.t; - name_norm: string -> string; - } - - let create ?(case_insensitive=false) nm = - { - name = nm; - fields = Hashtbl.create 13; - order = Queue.create (); - name_norm = - (if case_insensitive then - OASISString.lowercase_ascii - else - fun s -> s); - } - - let add t nm set get extra help = - let key = - t.name_norm nm - in - - if Hashtbl.mem t.fields key then - failwith - (Printf.sprintf - (f_ "Field '%s' is already defined in schema '%s'") - nm t.name); - Hashtbl.add - t.fields - key - { - set = set; - get = get; - help = help; - extra = extra; - }; - Queue.add nm t.order - - let mem t nm = - Hashtbl.mem t.fields nm - - let find t nm = - try - Hashtbl.find t.fields (t.name_norm nm) - with Not_found -> - raise (Unknown_field (nm, t.name)) - - let get t data nm = - (find t nm).get data - - let set t data nm ?context x = - (find t nm).set - data - ?context - x - - let fold f acc t = - Queue.fold - (fun acc k -> - let v = - find t k - in - f acc k v.extra v.help) - acc - t.order - - let iter f t = - fold - (fun () -> f) - () - t - - let name t = - t.name - end - - - module Field = - struct - type ('ctxt, 'value, 'extra) t = - { - set: Data.t -> ?context:'ctxt -> 'value -> unit; - get: Data.t -> 'value; - sets: Data.t -> ?context:'ctxt -> string -> unit; - gets: Data.t -> string; - help: (unit -> string) option; - extra: 'extra; - } - - let new_id = - let last_id = - ref 0 - in - fun () -> incr last_id; !last_id - - let create ?schema ?name ?parse ?print ?default ?update ?help extra = - (* Default value container *) - let v = - ref None - in - - (* If name is not given, create unique one *) - let nm = - match name with - | Some s -> s - | None -> Printf.sprintf "_anon_%d" (new_id ()) - in - - (* Last chance to get a value: the default *) - let default () = - match default with - | Some d -> d - | None -> raise (Not_set (nm, Some (s_ "no default value"))) - in - - (* Get data *) - let get data = - (* Get value *) - try - (Hashtbl.find data nm) (); - match !v with - | Some x -> x - | None -> default () - with Not_found -> - default () - in - - (* Set data *) - let set data ?context x = - let x = - match update with - | Some f -> - begin - try - f ?context (get data) x - with Not_set _ -> - x - end - | None -> - x - in - Hashtbl.replace - data - nm - (fun () -> v := Some x) - in - - (* Parse string value, if possible *) - let parse = - match parse with - | Some f -> - f - | None -> - fun ?context s -> - failwith - (Printf.sprintf - (f_ "Cannot parse field '%s' when setting value %S") - nm - s) - in - - (* Set data, from string *) - let sets data ?context s = - set ?context data (parse ?context s) - in - - (* Output value as string, if possible *) - let print = - match print with - | Some f -> - f - | None -> - fun _ -> raise (No_printer nm) - in - - (* Get data, as a string *) - let gets data = - print (get data) - in - - begin - match schema with - | Some t -> - Schema.add t nm sets gets extra help - | None -> - () - end; - - { - set = set; - get = get; - sets = sets; - gets = gets; - help = help; - extra = extra; - } - - let fset data t ?context x = - t.set data ?context x - - let fget data t = - t.get data - - let fsets data t ?context s = - t.sets data ?context s - - let fgets data t = - t.gets data - end - - - module FieldRO = - struct - let create ?schema ?name ?parse ?print ?default ?update ?help extra = - let fld = - Field.create ?schema ?name ?parse ?print ?default ?update ?help extra - in - fun data -> Field.fget data fld - end -end - -module OASISMessage = struct -(* # 22 "src/oasis/OASISMessage.ml" *) - - - open OASISGettext - open OASISContext - - - let generic_message ~ctxt lvl fmt = - let cond = - if ctxt.quiet then - false - else - match lvl with - | `Debug -> ctxt.debug - | `Info -> ctxt.info - | _ -> true - in - Printf.ksprintf - (fun str -> - if cond then - begin - ctxt.printf lvl str - end) - fmt - - - let debug ~ctxt fmt = - generic_message ~ctxt `Debug fmt - - - let info ~ctxt fmt = - generic_message ~ctxt `Info fmt - - - let warning ~ctxt fmt = - generic_message ~ctxt `Warning fmt - - - let error ~ctxt fmt = - generic_message ~ctxt `Error fmt - -end - -module OASISVersion = struct -(* # 22 "src/oasis/OASISVersion.ml" *) - - - open OASISGettext - - - type t = string - - - type comparator = - | VGreater of t - | VGreaterEqual of t - | VEqual of t - | VLesser of t - | VLesserEqual of t - | VOr of comparator * comparator - | VAnd of comparator * comparator - - - (* Range of allowed characters *) - let is_digit c = '0' <= c && c <= '9' - let is_alpha c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') - let is_special = function | '.' | '+' | '-' | '~' -> true | _ -> false - - - let rec version_compare v1 v2 = - if v1 <> "" || v2 <> "" then - begin - (* Compare ascii string, using special meaning for version - * related char - *) - let val_ascii c = - if c = '~' then -1 - else if is_digit c then 0 - else if c = '\000' then 0 - else if is_alpha c then Char.code c - else (Char.code c) + 256 - in - - let len1 = String.length v1 in - let len2 = String.length v2 in - - let p = ref 0 in - - (** Compare ascii part *) - let compare_vascii () = - let cmp = ref 0 in - while !cmp = 0 && - !p < len1 && !p < len2 && - not (is_digit v1.[!p] && is_digit v2.[!p]) do - cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]); - incr p - done; - if !cmp = 0 && !p < len1 && !p = len2 then - val_ascii v1.[!p] - else if !cmp = 0 && !p = len1 && !p < len2 then - - (val_ascii v2.[!p]) - else - !cmp - in - - (** Compare digit part *) - let compare_digit () = - let extract_int v p = - let start_p = !p in - while !p < String.length v && is_digit v.[!p] do - incr p - done; - let substr = - String.sub v !p ((String.length v) - !p) - in - let res = - match String.sub v start_p (!p - start_p) with - | "" -> 0 - | s -> int_of_string s - in - res, substr - in - let i1, tl1 = extract_int v1 (ref !p) in - let i2, tl2 = extract_int v2 (ref !p) in - i1 - i2, tl1, tl2 - in - - match compare_vascii () with - | 0 -> - begin - match compare_digit () with - | 0, tl1, tl2 -> - if tl1 <> "" && is_digit tl1.[0] then - 1 - else if tl2 <> "" && is_digit tl2.[0] then - -1 - else - version_compare tl1 tl2 - | n, _, _ -> - n - end - | n -> - n - end - else begin - 0 - end - - - let version_of_string str = str - - - let string_of_version t = t - - - let chop t = - try - let pos = - String.rindex t '.' - in - String.sub t 0 pos - with Not_found -> - t - - - let rec comparator_apply v op = - match op with - | VGreater cv -> - (version_compare v cv) > 0 - | VGreaterEqual cv -> - (version_compare v cv) >= 0 - | VLesser cv -> - (version_compare v cv) < 0 - | VLesserEqual cv -> - (version_compare v cv) <= 0 - | VEqual cv -> - (version_compare v cv) = 0 - | VOr (op1, op2) -> - (comparator_apply v op1) || (comparator_apply v op2) - | VAnd (op1, op2) -> - (comparator_apply v op1) && (comparator_apply v op2) - - - let rec string_of_comparator = - function - | VGreater v -> "> "^(string_of_version v) - | VEqual v -> "= "^(string_of_version v) - | VLesser v -> "< "^(string_of_version v) - | VGreaterEqual v -> ">= "^(string_of_version v) - | VLesserEqual v -> "<= "^(string_of_version v) - | VOr (c1, c2) -> - (string_of_comparator c1)^" || "^(string_of_comparator c2) - | VAnd (c1, c2) -> - (string_of_comparator c1)^" && "^(string_of_comparator c2) - - - let rec varname_of_comparator = - let concat p v = - OASISUtils.varname_concat - p - (OASISUtils.varname_of_string - (string_of_version v)) - in - function - | VGreater v -> concat "gt" v - | VLesser v -> concat "lt" v - | VEqual v -> concat "eq" v - | VGreaterEqual v -> concat "ge" v - | VLesserEqual v -> concat "le" v - | VOr (c1, c2) -> - (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2) - | VAnd (c1, c2) -> - (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2) - - -end - -module OASISLicense = struct -(* # 22 "src/oasis/OASISLicense.ml" *) - - - (** License for _oasis fields - @author Sylvain Le Gall - *) - - - type license = string - type license_exception = string - - - type license_version = - | Version of OASISVersion.t - | VersionOrLater of OASISVersion.t - | NoVersion - - - type license_dep_5_unit = - { - license: license; - excption: license_exception option; - version: license_version; - } - - - type license_dep_5 = - | DEP5Unit of license_dep_5_unit - | DEP5Or of license_dep_5 list - | DEP5And of license_dep_5 list - - - type t = - | DEP5License of license_dep_5 - | OtherLicense of string (* URL *) - - -end - -module OASISExpr = struct -(* # 22 "src/oasis/OASISExpr.ml" *) - - - open OASISGettext - open OASISUtils - - - type test = string - type flag = string - - - type t = - | EBool of bool - | ENot of t - | EAnd of t * t - | EOr of t * t - | EFlag of flag - | ETest of test * string - - - type 'a choices = (t * 'a) list - - - let eval var_get t = - let rec eval' = - function - | EBool b -> - b - - | ENot e -> - not (eval' e) - - | EAnd (e1, e2) -> - (eval' e1) && (eval' e2) - - | EOr (e1, e2) -> - (eval' e1) || (eval' e2) - - | EFlag nm -> - let v = - var_get nm - in - assert(v = "true" || v = "false"); - (v = "true") - - | ETest (nm, vl) -> - let v = - var_get nm - in - (v = vl) - in - eval' t - - - let choose ?printer ?name var_get lst = - let rec choose_aux = - function - | (cond, vl) :: tl -> - if eval var_get cond then - vl - else - choose_aux tl - | [] -> - let str_lst = - if lst = [] then - s_ "" - else - String.concat - (s_ ", ") - (List.map - (fun (cond, vl) -> - match printer with - | Some p -> p vl - | None -> s_ "") - lst) - in - match name with - | Some nm -> - failwith - (Printf.sprintf - (f_ "No result for the choice list '%s': %s") - nm str_lst) - | None -> - failwith - (Printf.sprintf - (f_ "No result for a choice list: %s") - str_lst) - in - choose_aux (List.rev lst) - - -end - -module OASISText = struct -(* # 22 "src/oasis/OASISText.ml" *) - - type elt = - | Para of string - | Verbatim of string - | BlankLine - - type t = elt list - -end - -module OASISSourcePatterns = struct -(* # 22 "src/oasis/OASISSourcePatterns.ml" *) - - open OASISUtils - open OASISGettext - - module Templater = - struct - (* TODO: use this module in BaseEnv.var_expand and BaseFileAB, at least. *) - type t = - { - atoms: atom list; - origin: string - } - and atom = - | Text of string - | Expr of expr - and expr = - | Ident of string - | String of string - | Call of string * expr - - - type env = - { - variables: string MapString.t; - functions: (string -> string) MapString.t; - } - - - let eval env t = - let rec eval_expr env = - function - | String str -> str - | Ident nm -> - begin - try - MapString.find nm env.variables - with Not_found -> - (* TODO: add error location within the string. *) - failwithf - (f_ "Unable to find variable %S in source pattern %S") - nm t.origin - end - - | Call (fn, expr) -> - begin - try - (MapString.find fn env.functions) (eval_expr env expr) - with Not_found -> - (* TODO: add error location within the string. *) - failwithf - (f_ "Unable to find function %S in source pattern %S") - fn t.origin - end - in - String.concat "" - (List.map - (function - | Text str -> str - | Expr expr -> eval_expr env expr) - t.atoms) - - - let parse env s = - let lxr = Genlex.make_lexer [] in - let parse_expr s = - let st = lxr (Stream.of_string s) in - match Stream.npeek 3 st with - | [Genlex.Ident fn; Genlex.Ident nm] -> Call(fn, Ident nm) - | [Genlex.Ident fn; Genlex.String str] -> Call(fn, String str) - | [Genlex.String str] -> String str - | [Genlex.Ident nm] -> Ident nm - (* TODO: add error location within the string. *) - | _ -> failwithf (f_ "Unable to parse expression %S") s - in - let parse s = - let lst_exprs = ref [] in - let ss = - let buff = Buffer.create (String.length s) in - Buffer.add_substitute - buff - (fun s -> lst_exprs := (parse_expr s) :: !lst_exprs; "\000") - s; - Buffer.contents buff - in - let rec join = - function - | hd1 :: tl1, hd2 :: tl2 -> Text hd1 :: Expr hd2 :: join (tl1, tl2) - | [], tl -> List.map (fun e -> Expr e) tl - | tl, [] -> List.map (fun e -> Text e) tl - in - join (OASISString.nsplit ss '\000', List.rev (!lst_exprs)) - in - let t = {atoms = parse s; origin = s} in - (* We rely on a simple evaluation for checking variables/functions. - It works because there is no if/loop statement. - *) - let _s : string = eval env t in - t - -(* # 144 "src/oasis/OASISSourcePatterns.ml" *) - end - - - type t = Templater.t - - - let env ~modul () = - { - Templater. - variables = MapString.of_list ["module", modul]; - functions = MapString.of_list - [ - "capitalize_file", OASISUnixPath.capitalize_file; - "uncapitalize_file", OASISUnixPath.uncapitalize_file; - ]; - } - - let all_possible_files lst ~path ~modul = - let eval = Templater.eval (env ~modul ()) in - List.fold_left - (fun acc pat -> OASISUnixPath.concat path (eval pat) :: acc) - [] lst - - - let to_string t = t.Templater.origin - - -end - -module OASISTypes = struct -(* # 22 "src/oasis/OASISTypes.ml" *) - - - type name = string - type package_name = string - type url = string - type unix_dirname = string - type unix_filename = string (* TODO: replace everywhere. *) - type host_dirname = string (* TODO: replace everywhere. *) - type host_filename = string (* TODO: replace everywhere. *) - type prog = string - type arg = string - type args = string list - type command_line = (prog * arg list) - - - type findlib_name = string - type findlib_full = string - - - type compiled_object = - | Byte - | Native - | Best - - - type dependency = - | FindlibPackage of findlib_full * OASISVersion.comparator option - | InternalLibrary of name - - - type tool = - | ExternalTool of name - | InternalExecutable of name - - - type vcs = - | Darcs - | Git - | Svn - | Cvs - | Hg - | Bzr - | Arch - | Monotone - | OtherVCS of url - - - type plugin_kind = - [ `Configure - | `Build - | `Doc - | `Test - | `Install - | `Extra - ] - - - type plugin_data_purpose = - [ `Configure - | `Build - | `Install - | `Clean - | `Distclean - | `Install - | `Uninstall - | `Test - | `Doc - | `Extra - | `Other of string - ] - - - type 'a plugin = 'a * name * OASISVersion.t option - - - type all_plugin = plugin_kind plugin - - - type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list - - - type 'a conditional = 'a OASISExpr.choices - - - type custom = - { - pre_command: (command_line option) conditional; - post_command: (command_line option) conditional; - } - - - type common_section = - { - cs_name: name; - cs_data: PropList.Data.t; - cs_plugin_data: plugin_data; - } - - - type build_section = - { - bs_build: bool conditional; - bs_install: bool conditional; - bs_path: unix_dirname; - bs_compiled_object: compiled_object; - bs_build_depends: dependency list; - bs_build_tools: tool list; - bs_interface_patterns: OASISSourcePatterns.t list; - bs_implementation_patterns: OASISSourcePatterns.t list; - bs_c_sources: unix_filename list; - bs_data_files: (unix_filename * unix_filename option) list; - bs_findlib_extra_files: unix_filename list; - bs_ccopt: args conditional; - bs_cclib: args conditional; - bs_dlllib: args conditional; - bs_dllpath: args conditional; - bs_byteopt: args conditional; - bs_nativeopt: args conditional; - } - - - type library = - { - lib_modules: string list; - lib_pack: bool; - lib_internal_modules: string list; - lib_findlib_parent: findlib_name option; - lib_findlib_name: findlib_name option; - lib_findlib_directory: unix_dirname option; - lib_findlib_containers: findlib_name list; - } - - - type object_ = - { - obj_modules: string list; - obj_findlib_fullname: findlib_name list option; - obj_findlib_directory: unix_dirname option; - } - - - type executable = - { - exec_custom: bool; - exec_main_is: unix_filename; - } - - - type flag = - { - flag_description: string option; - flag_default: bool conditional; - } - - - type source_repository = - { - src_repo_type: vcs; - src_repo_location: url; - src_repo_browser: url option; - src_repo_module: string option; - src_repo_branch: string option; - src_repo_tag: string option; - src_repo_subdir: unix_filename option; - } - - - type test = - { - test_type: [`Test] plugin; - test_command: command_line conditional; - test_custom: custom; - test_working_directory: unix_filename option; - test_run: bool conditional; - test_tools: tool list; - } - - - type doc_format = - | HTML of unix_filename (* TODO: source filename. *) - | DocText - | PDF - | PostScript - | Info of unix_filename (* TODO: source filename. *) - | DVI - | OtherDoc - - - type doc = - { - doc_type: [`Doc] plugin; - doc_custom: custom; - doc_build: bool conditional; - doc_install: bool conditional; - doc_install_dir: unix_filename; (* TODO: dest filename ?. *) - doc_title: string; - doc_authors: string list; - doc_abstract: string option; - doc_format: doc_format; - (* TODO: src filename. *) - doc_data_files: (unix_filename * unix_filename option) list; - doc_build_tools: tool list; - } - - - type section = - | Library of common_section * build_section * library - | Object of common_section * build_section * object_ - | Executable of common_section * build_section * executable - | Flag of common_section * flag - | SrcRepo of common_section * source_repository - | Test of common_section * test - | Doc of common_section * doc - - - type section_kind = - [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ] - - - type package = - { - oasis_version: OASISVersion.t; - ocaml_version: OASISVersion.comparator option; - findlib_version: OASISVersion.comparator option; - alpha_features: string list; - beta_features: string list; - name: package_name; - version: OASISVersion.t; - license: OASISLicense.t; - license_file: unix_filename option; (* TODO: source filename. *) - copyrights: string list; - maintainers: string list; - authors: string list; - homepage: url option; - bugreports: url option; - synopsis: string; - description: OASISText.t option; - tags: string list; - categories: url list; - - conf_type: [`Configure] plugin; - conf_custom: custom; - - build_type: [`Build] plugin; - build_custom: custom; - - install_type: [`Install] plugin; - install_custom: custom; - uninstall_custom: custom; - - clean_custom: custom; - distclean_custom: custom; - - files_ab: unix_filename list; (* TODO: source filename. *) - sections: section list; - plugins: [`Extra] plugin list; - disable_oasis_section: unix_filename list; (* TODO: source filename. *) - schema_data: PropList.Data.t; - plugin_data: plugin_data; - } - - -end - -module OASISFeatures = struct -(* # 22 "src/oasis/OASISFeatures.ml" *) - - open OASISTypes - open OASISUtils - open OASISGettext - open OASISVersion - - module MapPlugin = - Map.Make - (struct - type t = plugin_kind * name - let compare = Pervasives.compare - end) - - module Data = - struct - type t = - { - oasis_version: OASISVersion.t; - plugin_versions: OASISVersion.t option MapPlugin.t; - alpha_features: string list; - beta_features: string list; - } - - let create oasis_version alpha_features beta_features = - { - oasis_version = oasis_version; - plugin_versions = MapPlugin.empty; - alpha_features = alpha_features; - beta_features = beta_features - } - - let of_package pkg = - create - pkg.OASISTypes.oasis_version - pkg.OASISTypes.alpha_features - pkg.OASISTypes.beta_features - - let add_plugin (plugin_kind, plugin_name, plugin_version) t = - {t with - plugin_versions = MapPlugin.add - (plugin_kind, plugin_name) - plugin_version - t.plugin_versions} - - let plugin_version plugin_kind plugin_name t = - MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions - - let to_string t = - Printf.sprintf - "oasis_version: %s; alpha_features: %s; beta_features: %s; \ - plugins_version: %s" - (OASISVersion.string_of_version (t:t).oasis_version) - (String.concat ", " t.alpha_features) - (String.concat ", " t.beta_features) - (String.concat ", " - (MapPlugin.fold - (fun (_, plg) ver_opt acc -> - (plg^ - (match ver_opt with - | Some v -> - " "^(OASISVersion.string_of_version v) - | None -> "")) - :: acc) - t.plugin_versions [])) - end - - type origin = - | Field of string * string - | Section of string - | NoOrigin - - type stage = Alpha | Beta - - - let string_of_stage = - function - | Alpha -> "alpha" - | Beta -> "beta" - - - let field_of_stage = - function - | Alpha -> "AlphaFeatures" - | Beta -> "BetaFeatures" - - type publication = InDev of stage | SinceVersion of OASISVersion.t - - type t = - { - name: string; - plugin: all_plugin option; - publication: publication; - description: unit -> string; - } - - (* TODO: mutex protect this. *) - let all_features = Hashtbl.create 13 - - - let since_version ver_str = SinceVersion (version_of_string ver_str) - let alpha = InDev Alpha - let beta = InDev Beta - - - let to_string t = - Printf.sprintf - "feature: %s; plugin: %s; publication: %s" - (t:t).name - (match t.plugin with - | None -> "" - | Some (_, nm, _) -> nm) - (match t.publication with - | InDev stage -> string_of_stage stage - | SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver)) - - let data_check t data origin = - let no_message = "no message" in - - let check_feature features stage = - let has_feature = List.mem (t:t).name features in - if not has_feature then - match (origin:origin) with - | Field (fld, where) -> - Some - (Printf.sprintf - (f_ "Field %s in %s is only available when feature %s \ - is in field %s.") - fld where t.name (field_of_stage stage)) - | Section sct -> - Some - (Printf.sprintf - (f_ "Section %s is only available when features %s \ - is in field %s.") - sct t.name (field_of_stage stage)) - | NoOrigin -> - Some no_message - else - None - in - - let version_is_good ~min_version version fmt = - let version_is_good = - OASISVersion.comparator_apply - version (OASISVersion.VGreaterEqual min_version) - in - Printf.ksprintf - (fun str -> if version_is_good then None else Some str) - fmt - in - - match origin, t.plugin, t.publication with - | _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha - | _, _, InDev Beta -> check_feature data.Data.beta_features Beta - | Field(fld, where), None, SinceVersion min_version -> - version_is_good ~min_version data.Data.oasis_version - (f_ "Field %s in %s is only valid since OASIS v%s, update \ - OASISFormat field from '%s' to '%s' after checking \ - OASIS changelog.") - fld where (string_of_version min_version) - (string_of_version data.Data.oasis_version) - (string_of_version min_version) - - | Field(fld, where), Some(plugin_knd, plugin_name, _), - SinceVersion min_version -> - begin - try - let plugin_version_current = - try - match Data.plugin_version plugin_knd plugin_name data with - | Some ver -> ver - | None -> - failwithf - (f_ "Field %s in %s is only valid for the OASIS \ - plugin %s since v%s, but no plugin version is \ - defined in the _oasis file, change '%s' to \ - '%s (%s)' in your _oasis file.") - fld where plugin_name (string_of_version min_version) - plugin_name - plugin_name (string_of_version min_version) - with Not_found -> - failwithf - (f_ "Field %s in %s is only valid when the OASIS plugin %s \ - is defined.") - fld where plugin_name - in - version_is_good ~min_version plugin_version_current - (f_ "Field %s in %s is only valid for the OASIS plugin %s \ - since v%s, update your plugin from '%s (%s)' to \ - '%s (%s)' after checking the plugin's changelog.") - fld where plugin_name (string_of_version min_version) - plugin_name (string_of_version plugin_version_current) - plugin_name (string_of_version min_version) - with Failure msg -> - Some msg - end - - | Section sct, None, SinceVersion min_version -> - version_is_good ~min_version data.Data.oasis_version - (f_ "Section %s is only valid for since OASIS v%s, update \ - OASISFormat field from '%s' to '%s' after checking OASIS \ - changelog.") - sct (string_of_version min_version) - (string_of_version data.Data.oasis_version) - (string_of_version min_version) - - | Section sct, Some(plugin_knd, plugin_name, _), - SinceVersion min_version -> - begin - try - let plugin_version_current = - try - match Data.plugin_version plugin_knd plugin_name data with - | Some ver -> ver - | None -> - failwithf - (f_ "Section %s is only valid for the OASIS \ - plugin %s since v%s, but no plugin version is \ - defined in the _oasis file, change '%s' to \ - '%s (%s)' in your _oasis file.") - sct plugin_name (string_of_version min_version) - plugin_name - plugin_name (string_of_version min_version) - with Not_found -> - failwithf - (f_ "Section %s is only valid when the OASIS plugin %s \ - is defined.") - sct plugin_name - in - version_is_good ~min_version plugin_version_current - (f_ "Section %s is only valid for the OASIS plugin %s \ - since v%s, update your plugin from '%s (%s)' to \ - '%s (%s)' after checking the plugin's changelog.") - sct plugin_name (string_of_version min_version) - plugin_name (string_of_version plugin_version_current) - plugin_name (string_of_version min_version) - with Failure msg -> - Some msg - end - - | NoOrigin, None, SinceVersion min_version -> - version_is_good ~min_version data.Data.oasis_version "%s" no_message - - | NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version -> - begin - try - let plugin_version_current = - match Data.plugin_version plugin_knd plugin_name data with - | Some ver -> ver - | None -> raise Not_found - in - version_is_good ~min_version plugin_version_current - "%s" no_message - with Not_found -> - Some no_message - end - - - let data_assert t data origin = - match data_check t data origin with - | None -> () - | Some str -> failwith str - - - let data_test t data = - match data_check t data NoOrigin with - | None -> true - | Some _ -> false - - - let package_test t pkg = - data_test t (Data.of_package pkg) - - - let create ?plugin name publication description = - let () = - if Hashtbl.mem all_features name then - failwithf "Feature '%s' is already declared." name - in - let t = - { - name = name; - plugin = plugin; - publication = publication; - description = description; - } - in - Hashtbl.add all_features name t; - t - - - let get_stage name = - try - (Hashtbl.find all_features name).publication - with Not_found -> - failwithf (f_ "Feature %s doesn't exist.") name - - - let list () = - Hashtbl.fold (fun _ v acc -> v :: acc) all_features [] - - (* - * Real flags. - *) - - - let features = - create "features_fields" - (since_version "0.4") - (fun () -> - s_ "Enable to experiment not yet official features.") - - - let flag_docs = - create "flag_docs" - (since_version "0.3") - (fun () -> - s_ "Make building docs require '-docs' flag at configure.") - - - let flag_tests = - create "flag_tests" - (since_version "0.3") - (fun () -> - s_ "Make running tests require '-tests' flag at configure.") - - - let pack = - create "pack" - (since_version "0.3") - (fun () -> - s_ "Allow to create packed library.") - - - let section_object = - create "section_object" beta - (fun () -> - s_ "Implement an object section.") - - - let dynrun_for_release = - create "dynrun_for_release" alpha - (fun () -> - s_ "Make '-setup-update dynamic' suitable for releasing project.") - - - let compiled_setup_ml = - create "compiled_setup_ml" alpha - (fun () -> - s_ "Compile the setup.ml and speed-up actions done with it.") - - let disable_oasis_section = - create "disable_oasis_section" alpha - (fun () -> - s_ "Allow the OASIS section comments and digests to be omitted in \ - generated files.") - - let no_automatic_syntax = - create "no_automatic_syntax" alpha - (fun () -> - s_ "Disable the automatic inclusion of -syntax camlp4o for packages \ - that matches the internal heuristic (if a dependency ends with \ - a .syntax or is a well known syntax).") - - let findlib_directory = - create "findlib_directory" beta - (fun () -> - s_ "Allow to install findlib libraries in sub-directories of the target \ - findlib directory.") - - let findlib_extra_files = - create "findlib_extra_files" beta - (fun () -> - s_ "Allow to install extra files for findlib libraries.") - - let source_patterns = - create "source_patterns" alpha - (fun () -> - s_ "Customize mapping between module name and source file.") -end - -module OASISSection = struct -(* # 22 "src/oasis/OASISSection.ml" *) - - - open OASISTypes - - - let section_kind_common = - function - | Library (cs, _, _) -> - `Library, cs - | Object (cs, _, _) -> - `Object, cs - | Executable (cs, _, _) -> - `Executable, cs - | Flag (cs, _) -> - `Flag, cs - | SrcRepo (cs, _) -> - `SrcRepo, cs - | Test (cs, _) -> - `Test, cs - | Doc (cs, _) -> - `Doc, cs - - - let section_common sct = - snd (section_kind_common sct) - - - let section_common_set cs = - function - | Library (_, bs, lib) -> Library (cs, bs, lib) - | Object (_, bs, obj) -> Object (cs, bs, obj) - | Executable (_, bs, exec) -> Executable (cs, bs, exec) - | Flag (_, flg) -> Flag (cs, flg) - | SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo) - | Test (_, tst) -> Test (cs, tst) - | Doc (_, doc) -> Doc (cs, doc) - - - (** Key used to identify section - *) - let section_id sct = - let k, cs = - section_kind_common sct - in - k, cs.cs_name - - - let string_of_section_kind = - function - | `Library -> "library" - | `Object -> "object" - | `Executable -> "executable" - | `Flag -> "flag" - | `SrcRepo -> "src repository" - | `Test -> "test" - | `Doc -> "doc" - - - let string_of_section sct = - let k, nm = section_id sct in - (string_of_section_kind k)^" "^nm - - - let section_find id scts = - List.find - (fun sct -> id = section_id sct) - scts - - - module CSection = - struct - type t = section - - let id = section_id - - let compare t1 t2 = - compare (id t1) (id t2) - - let equal t1 t2 = - (id t1) = (id t2) - - let hash t = - Hashtbl.hash (id t) - end - - - module MapSection = Map.Make(CSection) - module SetSection = Set.Make(CSection) - - -end - -module OASISBuildSection = struct -(* # 22 "src/oasis/OASISBuildSection.ml" *) - - open OASISTypes - - (* Look for a module file, considering capitalization or not. *) - let find_module source_file_exists bs modul = - let possible_lst = - OASISSourcePatterns.all_possible_files - (bs.bs_interface_patterns @ bs.bs_implementation_patterns) - ~path:bs.bs_path - ~modul - in - match List.filter source_file_exists possible_lst with - | (fn :: _) as fn_lst -> `Sources (OASISUnixPath.chop_extension fn, fn_lst) - | [] -> - let open OASISUtils in - let _, rev_lst = - List.fold_left - (fun (set, acc) fn -> - let base_fn = OASISUnixPath.chop_extension fn in - if SetString.mem base_fn set then - set, acc - else - SetString.add base_fn set, base_fn :: acc) - (SetString.empty, []) possible_lst - in - `No_sources (List.rev rev_lst) - - -end - -module OASISExecutable = struct -(* # 22 "src/oasis/OASISExecutable.ml" *) - - - open OASISTypes - - - let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program = - let dir = - OASISUnixPath.concat - bs.bs_path - (OASISUnixPath.dirname exec.exec_main_is) - in - let is_native_exec = - match bs.bs_compiled_object with - | Native -> true - | Best -> is_native () - | Byte -> false - in - - OASISUnixPath.concat - dir - (cs.cs_name^(suffix_program ())), - - if not is_native_exec && - not exec.exec_custom && - bs.bs_c_sources <> [] then - Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ())) - else - None - - -end - -module OASISLibrary = struct -(* # 22 "src/oasis/OASISLibrary.ml" *) - - - open OASISTypes - open OASISGettext - - let find_module ~ctxt source_file_exists cs bs modul = - match OASISBuildSection.find_module source_file_exists bs modul with - | `Sources _ as res -> res - | `No_sources _ as res -> - OASISMessage.warning - ~ctxt - (f_ "Cannot find source file matching module '%s' in library %s.") - modul cs.cs_name; - OASISMessage.warning - ~ctxt - (f_ "Use InterfacePatterns or ImplementationPatterns to define \ - this file with feature %S.") - (OASISFeatures.source_patterns.OASISFeatures.name); - res - - let source_unix_files ~ctxt (cs, bs, lib) source_file_exists = - List.fold_left - (fun acc modul -> - match find_module ~ctxt source_file_exists cs bs modul with - | `Sources (base_fn, lst) -> (base_fn, lst) :: acc - | `No_sources _ -> acc) - [] - (lib.lib_modules @ lib.lib_internal_modules) - - - let generated_unix_files - ~ctxt - ~is_native - ~has_native_dynlink - ~ext_lib - ~ext_dll - ~source_file_exists - (cs, bs, lib) = - - let find_modules lst ext = - let find_module modul = - match find_module ~ctxt source_file_exists cs bs modul with - | `Sources (_, [fn]) when ext <> "cmi" - && Filename.check_suffix fn ".mli" -> - None (* No implementation files for pure interface. *) - | `Sources (base_fn, _) -> Some [base_fn] - | `No_sources lst -> Some lst - in - List.fold_left - (fun acc nm -> - match find_module nm with - | None -> acc - | Some base_fns -> - List.map (fun base_fn -> base_fn ^"."^ext) base_fns :: acc) - [] - lst - in - - (* The .cmx that be compiled along *) - let cmxs = - let should_be_built = - match bs.bs_compiled_object with - | Native -> true - | Best -> is_native - | Byte -> false - in - if should_be_built then - if lib.lib_pack then - find_modules - [cs.cs_name] - "cmx" - else - find_modules - (lib.lib_modules @ lib.lib_internal_modules) - "cmx" - else - [] - in - - let acc_nopath = - [] - in - - (* The headers and annot/cmt files that should be compiled along *) - let headers = - let sufx = - if lib.lib_pack - then [".cmti"; ".cmt"; ".annot"] - else [".cmi"; ".cmti"; ".cmt"; ".annot"] - in - List.map - (List.fold_left - (fun accu s -> - let dot = String.rindex s '.' in - let base = String.sub s 0 dot in - List.map ((^) base) sufx @ accu) - []) - (find_modules lib.lib_modules "cmi") - in - - (* Compute what libraries should be built *) - let acc_nopath = - (* Add the packed header file if required *) - let add_pack_header acc = - if lib.lib_pack then - [cs.cs_name^".cmi"; cs.cs_name^".cmti"; cs.cs_name^".cmt"] :: acc - else - acc - in - let byte acc = - add_pack_header ([cs.cs_name^".cma"] :: acc) - in - let native acc = - let acc = - add_pack_header - (if has_native_dynlink then - [cs.cs_name^".cmxs"] :: acc - else acc) - in - [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc - in - match bs.bs_compiled_object with - | Native -> byte (native acc_nopath) - | Best when is_native -> byte (native acc_nopath) - | Byte | Best -> byte acc_nopath - in - - (* Add C library to be built *) - let acc_nopath = - if bs.bs_c_sources <> [] then begin - ["lib"^cs.cs_name^"_stubs"^ext_lib] - :: - if has_native_dynlink then - ["dll"^cs.cs_name^"_stubs"^ext_dll] :: acc_nopath - else - acc_nopath - end else begin - acc_nopath - end - in - - (* All the files generated *) - List.rev_append - (List.rev_map - (List.rev_map - (OASISUnixPath.concat bs.bs_path)) - acc_nopath) - (headers @ cmxs) - - -end - -module OASISObject = struct -(* # 22 "src/oasis/OASISObject.ml" *) - - - open OASISTypes - open OASISGettext - - - let find_module ~ctxt source_file_exists cs bs modul = - match OASISBuildSection.find_module source_file_exists bs modul with - | `Sources _ as res -> res - | `No_sources _ as res -> - OASISMessage.warning - ~ctxt - (f_ "Cannot find source file matching module '%s' in object %s.") - modul cs.cs_name; - OASISMessage.warning - ~ctxt - (f_ "Use InterfacePatterns or ImplementationPatterns to define \ - this file with feature %S.") - (OASISFeatures.source_patterns.OASISFeatures.name); - res - - let source_unix_files ~ctxt (cs, bs, obj) source_file_exists = - List.fold_left - (fun acc modul -> - match find_module ~ctxt source_file_exists cs bs modul with - | `Sources (base_fn, lst) -> (base_fn, lst) :: acc - | `No_sources _ -> acc) - [] - obj.obj_modules - - - let generated_unix_files - ~ctxt - ~is_native - ~source_file_exists - (cs, bs, obj) = - - let find_module ext modul = - match find_module ~ctxt source_file_exists cs bs modul with - | `Sources (base_fn, _) -> [base_fn ^ ext] - | `No_sources lst -> lst - in - - let header, byte, native, c_object, f = - match obj.obj_modules with - | [ m ] -> (find_module ".cmi" m, - find_module ".cmo" m, - find_module ".cmx" m, - find_module ".o" m, - fun x -> x) - | _ -> ([cs.cs_name ^ ".cmi"], - [cs.cs_name ^ ".cmo"], - [cs.cs_name ^ ".cmx"], - [cs.cs_name ^ ".o"], - OASISUnixPath.concat bs.bs_path) - in - List.map (List.map f) ( - match bs.bs_compiled_object with - | Native -> - native :: c_object :: byte :: header :: [] - | Best when is_native -> - native :: c_object :: byte :: header :: [] - | Byte | Best -> - byte :: header :: []) - - -end - -module OASISFindlib = struct -(* # 22 "src/oasis/OASISFindlib.ml" *) - - - open OASISTypes - open OASISUtils - open OASISGettext - - - type library_name = name - type findlib_part_name = name - type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t - - - exception InternalLibraryNotFound of library_name - exception FindlibPackageNotFound of findlib_name - - - type group_t = - | Container of findlib_name * group_t list - | Package of (findlib_name * - common_section * - build_section * - [`Library of library | `Object of object_] * - unix_dirname option * - group_t list) - - - type data = common_section * - build_section * - [`Library of library | `Object of object_] - type tree = - | Node of (data option) * (tree MapString.t) - | Leaf of data - - - let findlib_mapping pkg = - (* Map from library name to either full findlib name or parts + parent. *) - let fndlb_parts_of_lib_name = - let fndlb_parts cs lib = - let name = - match lib.lib_findlib_name with - | Some nm -> nm - | None -> cs.cs_name - in - let name = - String.concat "." (lib.lib_findlib_containers @ [name]) - in - name - in - List.fold_left - (fun mp -> - function - | Library (cs, _, lib) -> - begin - let lib_name = cs.cs_name in - let fndlb_parts = fndlb_parts cs lib in - if MapString.mem lib_name mp then - failwithf - (f_ "The library name '%s' is used more than once.") - lib_name; - match lib.lib_findlib_parent with - | Some lib_name_parent -> - MapString.add - lib_name - (`Unsolved (lib_name_parent, fndlb_parts)) - mp - | None -> - MapString.add - lib_name - (`Solved fndlb_parts) - mp - end - - | Object (cs, _, obj) -> - begin - let obj_name = cs.cs_name in - if MapString.mem obj_name mp then - failwithf - (f_ "The object name '%s' is used more than once.") - obj_name; - let findlib_full_name = match obj.obj_findlib_fullname with - | Some ns -> String.concat "." ns - | None -> obj_name - in - MapString.add - obj_name - (`Solved findlib_full_name) - mp - end - - | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ -> - mp) - MapString.empty - pkg.sections - in - - (* Solve the above graph to be only library name to full findlib name. *) - let fndlb_name_of_lib_name = - let rec solve visited mp lib_name lib_name_child = - if SetString.mem lib_name visited then - failwithf - (f_ "Library '%s' is involved in a cycle \ - with regard to findlib naming.") - lib_name; - let visited = SetString.add lib_name visited in - try - match MapString.find lib_name mp with - | `Solved fndlb_nm -> - fndlb_nm, mp - | `Unsolved (lib_nm_parent, post_fndlb_nm) -> - let pre_fndlb_nm, mp = - solve visited mp lib_nm_parent lib_name - in - let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in - fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp - with Not_found -> - failwithf - (f_ "Library '%s', which is defined as the findlib parent of \ - library '%s', doesn't exist.") - lib_name lib_name_child - in - let mp = - MapString.fold - (fun lib_name status mp -> - match status with - | `Solved _ -> - (* Solved initialy, no need to go further *) - mp - | `Unsolved _ -> - let _, mp = solve SetString.empty mp lib_name "" in - mp) - fndlb_parts_of_lib_name - fndlb_parts_of_lib_name - in - MapString.map - (function - | `Solved fndlb_nm -> fndlb_nm - | `Unsolved _ -> assert false) - mp - in - - (* Convert an internal library name to a findlib name. *) - let findlib_name_of_library_name lib_nm = - try - MapString.find lib_nm fndlb_name_of_lib_name - with Not_found -> - raise (InternalLibraryNotFound lib_nm) - in - - (* Add a library to the tree. - *) - let add sct mp = - let fndlb_fullname = - let cs, _, _ = sct in - let lib_name = cs.cs_name in - findlib_name_of_library_name lib_name - in - let rec add_children nm_lst (children: tree MapString.t) = - match nm_lst with - | (hd :: tl) -> - begin - let node = - try - add_node tl (MapString.find hd children) - with Not_found -> - (* New node *) - new_node tl - in - MapString.add hd node children - end - | [] -> - (* Should not have a nameless library. *) - assert false - and add_node tl node = - if tl = [] then - begin - match node with - | Node (None, children) -> - Node (Some sct, children) - | Leaf (cs', _, _) | Node (Some (cs', _, _), _) -> - (* TODO: allow to merge Package, i.e. - * archive(byte) = "foo.cma foo_init.cmo" - *) - let cs, _, _ = sct in - failwithf - (f_ "Library '%s' and '%s' have the same findlib name '%s'") - cs.cs_name cs'.cs_name fndlb_fullname - end - else - begin - match node with - | Leaf data -> - Node (Some data, add_children tl MapString.empty) - | Node (data_opt, children) -> - Node (data_opt, add_children tl children) - end - and new_node = - function - | [] -> - Leaf sct - | hd :: tl -> - Node (None, MapString.add hd (new_node tl) MapString.empty) - in - add_children (OASISString.nsplit fndlb_fullname '.') mp - in - - let unix_directory dn lib = - let directory = - match lib with - | `Library lib -> lib.lib_findlib_directory - | `Object obj -> obj.obj_findlib_directory - in - match dn, directory with - | None, None -> None - | None, Some dn | Some dn, None -> Some dn - | Some dn1, Some dn2 -> Some (OASISUnixPath.concat dn1 dn2) - in - - let rec group_of_tree dn mp = - MapString.fold - (fun nm node acc -> - let cur = - match node with - | Node (Some (cs, bs, lib), children) -> - let current_dn = unix_directory dn lib in - Package (nm, cs, bs, lib, current_dn, group_of_tree current_dn children) - | Node (None, children) -> - Container (nm, group_of_tree dn children) - | Leaf (cs, bs, lib) -> - let current_dn = unix_directory dn lib in - Package (nm, cs, bs, lib, current_dn, []) - in - cur :: acc) - mp [] - in - - let group_mp = - List.fold_left - (fun mp -> - function - | Library (cs, bs, lib) -> - add (cs, bs, `Library lib) mp - | Object (cs, bs, obj) -> - add (cs, bs, `Object obj) mp - | _ -> - mp) - MapString.empty - pkg.sections - in - - let groups = group_of_tree None group_mp in - - let library_name_of_findlib_name = - lazy begin - (* Revert findlib_name_of_library_name. *) - MapString.fold - (fun k v mp -> MapString.add v k mp) - fndlb_name_of_lib_name - MapString.empty - end - in - let library_name_of_findlib_name fndlb_nm = - try - MapString.find fndlb_nm (Lazy.force library_name_of_findlib_name) - with Not_found -> - raise (FindlibPackageNotFound fndlb_nm) - in - - groups, - findlib_name_of_library_name, - library_name_of_findlib_name - - - let findlib_of_group = - function - | Container (fndlb_nm, _) - | Package (fndlb_nm, _, _, _, _, _) -> fndlb_nm - - - let root_of_group grp = - let rec root_lib_aux = - (* We do a DFS in the group. *) - function - | Container (_, children) -> - List.fold_left - (fun res grp -> - if res = None then - root_lib_aux grp - else - res) - None - children - | Package (_, cs, bs, lib, _, _) -> - Some (cs, bs, lib) - in - match root_lib_aux grp with - | Some res -> - res - | None -> - failwithf - (f_ "Unable to determine root library of findlib library '%s'") - (findlib_of_group grp) - - -end - -module OASISFlag = struct -(* # 22 "src/oasis/OASISFlag.ml" *) - - -end - -module OASISPackage = struct -(* # 22 "src/oasis/OASISPackage.ml" *) - - -end - -module OASISSourceRepository = struct -(* # 22 "src/oasis/OASISSourceRepository.ml" *) - - -end - -module OASISTest = struct -(* # 22 "src/oasis/OASISTest.ml" *) - - -end - -module OASISDocument = struct -(* # 22 "src/oasis/OASISDocument.ml" *) - - -end - -module OASISExec = struct -(* # 22 "src/oasis/OASISExec.ml" *) - - - open OASISGettext - open OASISUtils - open OASISMessage - - - (* TODO: I don't like this quote, it is there because $(rm) foo expands to - * 'rm -f' foo... - *) - let run ~ctxt ?f_exit_code ?(quote=true) cmd args = - let cmd = - if quote then - if Sys.os_type = "Win32" then - if String.contains cmd ' ' then - (* Double the 1st double quote... win32... sigh *) - "\""^(Filename.quote cmd) - else - cmd - else - Filename.quote cmd - else - cmd - in - let cmdline = - String.concat " " (cmd :: args) - in - info ~ctxt (f_ "Running command '%s'") cmdline; - match f_exit_code, Sys.command cmdline with - | None, 0 -> () - | None, i -> - failwithf - (f_ "Command '%s' terminated with error code %d") - cmdline i - | Some f, i -> - f i - - - let run_read_output ~ctxt ?f_exit_code cmd args = - let fn = - Filename.temp_file "oasis-" ".txt" - in - try - begin - let () = - run ~ctxt ?f_exit_code cmd (args @ [">"; Filename.quote fn]) - in - let chn = - open_in fn - in - let routput = - ref [] - in - begin - try - while true do - routput := (input_line chn) :: !routput - done - with End_of_file -> - () - end; - close_in chn; - Sys.remove fn; - List.rev !routput - end - with e -> - (try Sys.remove fn with _ -> ()); - raise e - - - let run_read_one_line ~ctxt ?f_exit_code cmd args = - match run_read_output ~ctxt ?f_exit_code cmd args with - | [fst] -> - fst - | lst -> - failwithf - (f_ "Command return unexpected output %S") - (String.concat "\n" lst) -end - -module OASISFileUtil = struct -(* # 22 "src/oasis/OASISFileUtil.ml" *) - - - open OASISGettext - - - let file_exists_case fn = - let dirname = Filename.dirname fn in - let basename = Filename.basename fn in - if Sys.file_exists dirname then - if basename = Filename.current_dir_name then - true - else - List.mem - basename - (Array.to_list (Sys.readdir dirname)) - else - false - - - let find_file ?(case_sensitive=true) paths exts = - - (* Cardinal product of two list *) - let ( * ) lst1 lst2 = - List.flatten - (List.map - (fun a -> - List.map - (fun b -> a, b) - lst2) - lst1) - in - - let rec combined_paths lst = - match lst with - | p1 :: p2 :: tl -> - let acc = - (List.map - (fun (a, b) -> Filename.concat a b) - (p1 * p2)) - in - combined_paths (acc :: tl) - | [e] -> - e - | [] -> - [] - in - - let alternatives = - List.map - (fun (p, e) -> - if String.length e > 0 && e.[0] <> '.' then - p ^ "." ^ e - else - p ^ e) - ((combined_paths paths) * exts) - in - List.find (fun file -> - (if case_sensitive then - file_exists_case file - else - Sys.file_exists file) - && not (Sys.is_directory file) - ) alternatives - - - let which ~ctxt prg = - let path_sep = - match Sys.os_type with - | "Win32" -> - ';' - | _ -> - ':' - in - let path_lst = OASISString.nsplit (Sys.getenv "PATH") path_sep in - let exec_ext = - match Sys.os_type with - | "Win32" -> - "" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep) - | _ -> - [""] - in - find_file ~case_sensitive:false [path_lst; [prg]] exec_ext - - - (**/**) - let rec fix_dir dn = - (* Windows hack because Sys.file_exists "src\\" = false when - * Sys.file_exists "src" = true - *) - let ln = - String.length dn - in - if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then - fix_dir (String.sub dn 0 (ln - 1)) - else - dn - - - let q = Filename.quote - (**/**) - - - let cp ~ctxt ?(recurse=false) src tgt = - if recurse then - match Sys.os_type with - | "Win32" -> - OASISExec.run ~ctxt - "xcopy" [q src; q tgt; "/E"] - | _ -> - OASISExec.run ~ctxt - "cp" ["-r"; q src; q tgt] - else - OASISExec.run ~ctxt - (match Sys.os_type with - | "Win32" -> "copy" - | _ -> "cp") - [q src; q tgt] - - - let mkdir ~ctxt tgt = - OASISExec.run ~ctxt - (match Sys.os_type with - | "Win32" -> "md" - | _ -> "mkdir") - [q tgt] - - - let rec mkdir_parent ~ctxt f tgt = - let tgt = - fix_dir tgt - in - if Sys.file_exists tgt then - begin - if not (Sys.is_directory tgt) then - OASISUtils.failwithf - (f_ "Cannot create directory '%s', a file of the same name already \ - exists") - tgt - end - else - begin - mkdir_parent ~ctxt f (Filename.dirname tgt); - if not (Sys.file_exists tgt) then - begin - f tgt; - mkdir ~ctxt tgt - end - end - - - let rmdir ~ctxt tgt = - if Sys.readdir tgt = [||] then begin - match Sys.os_type with - | "Win32" -> - OASISExec.run ~ctxt "rd" [q tgt] - | _ -> - OASISExec.run ~ctxt "rm" ["-r"; q tgt] - end else begin - OASISMessage.error ~ctxt - (f_ "Cannot remove directory '%s': not empty.") - tgt - end - - - let glob ~ctxt fn = - let basename = - Filename.basename fn - in - if String.length basename >= 2 && - basename.[0] = '*' && - basename.[1] = '.' then - begin - let ext_len = - (String.length basename) - 2 - in - let ext = - String.sub basename 2 ext_len - in - let dirname = - Filename.dirname fn - in - Array.fold_left - (fun acc fn -> - try - let fn_ext = - String.sub - fn - ((String.length fn) - ext_len) - ext_len - in - if fn_ext = ext then - (Filename.concat dirname fn) :: acc - else - acc - with Invalid_argument _ -> - acc) - [] - (Sys.readdir dirname) - end - else - begin - if file_exists_case fn then - [fn] - else - [] - end -end - - -# 3159 "setup.ml" -module BaseEnvLight = struct -(* # 22 "src/base/BaseEnvLight.ml" *) - - - module MapString = Map.Make(String) - - - type t = string MapString.t - - - let default_filename = Filename.concat (Sys.getcwd ()) "setup.data" - - - let load ?(allow_empty=false) ?(filename=default_filename) ?stream () = - let line = ref 1 in - let lexer st = - let st_line = - Stream.from - (fun _ -> - try - match Stream.next st with - | '\n' -> incr line; Some '\n' - | c -> Some c - with Stream.Failure -> None) - in - Genlex.make_lexer ["="] st_line - in - let rec read_file lxr mp = - match Stream.npeek 3 lxr with - | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> - Stream.junk lxr; Stream.junk lxr; Stream.junk lxr; - read_file lxr (MapString.add nm value mp) - | [] -> mp - | _ -> - failwith - (Printf.sprintf "Malformed data file '%s' line %d" filename !line) - in - match stream with - | Some st -> read_file (lexer st) MapString.empty - | None -> - if Sys.file_exists filename then begin - let chn = open_in_bin filename in - let st = Stream.of_channel chn in - try - let mp = read_file (lexer st) MapString.empty in - close_in chn; mp - with e -> - close_in chn; raise e - end else if allow_empty then begin - MapString.empty - end else begin - failwith - (Printf.sprintf - "Unable to load environment, the file '%s' doesn't exist." - filename) - end - - let rec var_expand str env = - let buff = Buffer.create ((String.length str) * 2) in - Buffer.add_substitute - buff - (fun var -> - try - var_expand (MapString.find var env) env - with Not_found -> - failwith - (Printf.sprintf - "No variable %s defined when trying to expand %S." - var - str)) - str; - Buffer.contents buff - - - let var_get name env = var_expand (MapString.find name env) env - let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst -end - - -# 3239 "setup.ml" -module BaseContext = struct -(* # 22 "src/base/BaseContext.ml" *) - - (* TODO: get rid of this module. *) - open OASISContext - - - let args () = fst (fspecs ()) - - - let default = default - -end - -module BaseMessage = struct -(* # 22 "src/base/BaseMessage.ml" *) - - - (** Message to user, overrid for Base - @author Sylvain Le Gall - *) - open OASISMessage - open BaseContext - - - let debug fmt = debug ~ctxt:!default fmt - - - let info fmt = info ~ctxt:!default fmt - - - let warning fmt = warning ~ctxt:!default fmt - - - let error fmt = error ~ctxt:!default fmt - -end - -module BaseEnv = struct -(* # 22 "src/base/BaseEnv.ml" *) - - open OASISGettext - open OASISUtils - open OASISContext - open PropList - - - module MapString = BaseEnvLight.MapString - - - type origin_t = - | ODefault - | OGetEnv - | OFileLoad - | OCommandLine - - - type cli_handle_t = - | CLINone - | CLIAuto - | CLIWith - | CLIEnable - | CLIUser of (Arg.key * Arg.spec * Arg.doc) list - - - type definition_t = - { - hide: bool; - dump: bool; - cli: cli_handle_t; - arg_help: string option; - group: string option; - } - - - let schema = Schema.create "environment" - - - (* Environment data *) - let env = Data.create () - - - (* Environment data from file *) - let env_from_file = ref MapString.empty - - - (* Lexer for var *) - let var_lxr = Genlex.make_lexer [] - - - let rec var_expand str = - let buff = - Buffer.create ((String.length str) * 2) - in - Buffer.add_substitute - buff - (fun var -> - try - (* TODO: this is a quick hack to allow calling Test.Command - * without defining executable name really. I.e. if there is - * an exec Executable toto, then $(toto) should be replace - * by its real name. It is however useful to have this function - * for other variable that depend on the host and should be - * written better than that. - *) - let st = - var_lxr (Stream.of_string var) - in - match Stream.npeek 3 st with - | [Genlex.Ident "utoh"; Genlex.Ident nm] -> - OASISHostPath.of_unix (var_get nm) - | [Genlex.Ident "utoh"; Genlex.String s] -> - OASISHostPath.of_unix s - | [Genlex.Ident "ocaml_escaped"; Genlex.Ident nm] -> - String.escaped (var_get nm) - | [Genlex.Ident "ocaml_escaped"; Genlex.String s] -> - String.escaped s - | [Genlex.Ident nm] -> - var_get nm - | _ -> - failwithf - (f_ "Unknown expression '%s' in variable expansion of %s.") - var - str - with - | Unknown_field (_, _) -> - failwithf - (f_ "No variable %s defined when trying to expand %S.") - var - str - | Stream.Error e -> - failwithf - (f_ "Syntax error when parsing '%s' when trying to \ - expand %S: %s") - var - str - e) - str; - Buffer.contents buff - - - and var_get name = - let vl = - try - Schema.get schema env name - with Unknown_field _ as e -> - begin - try - MapString.find name !env_from_file - with Not_found -> - raise e - end - in - var_expand vl - - - let var_choose ?printer ?name lst = - OASISExpr.choose - ?printer - ?name - var_get - lst - - - let var_protect vl = - let buff = - Buffer.create (String.length vl) - in - String.iter - (function - | '$' -> Buffer.add_string buff "\\$" - | c -> Buffer.add_char buff c) - vl; - Buffer.contents buff - - - let var_define - ?(hide=false) - ?(dump=true) - ?short_desc - ?(cli=CLINone) - ?arg_help - ?group - name (* TODO: type constraint on the fact that name must be a valid OCaml - id *) - dflt = - - let default = - [ - OFileLoad, (fun () -> MapString.find name !env_from_file); - ODefault, dflt; - OGetEnv, (fun () -> Sys.getenv name); - ] - in - - let extra = - { - hide = hide; - dump = dump; - cli = cli; - arg_help = arg_help; - group = group; - } - in - - (* Try to find a value that can be defined - *) - let var_get_low lst = - let errors, res = - List.fold_left - (fun (errors, res) (_, v) -> - if res = None then - begin - try - errors, Some (v ()) - with - | Not_found -> - errors, res - | Failure rsn -> - (rsn :: errors), res - | e -> - (Printexc.to_string e) :: errors, res - end - else - errors, res) - ([], None) - (List.sort - (fun (o1, _) (o2, _) -> - Pervasives.compare o2 o1) - lst) - in - match res, errors with - | Some v, _ -> - v - | None, [] -> - raise (Not_set (name, None)) - | None, lst -> - raise (Not_set (name, Some (String.concat (s_ ", ") lst))) - in - - let help = - match short_desc with - | Some fs -> Some fs - | None -> None - in - - let var_get_lst = - FieldRO.create - ~schema - ~name - ~parse:(fun ?(context=ODefault) s -> [context, fun () -> s]) - ~print:var_get_low - ~default - ~update:(fun ?context:_ x old_x -> x @ old_x) - ?help - extra - in - - fun () -> - var_expand (var_get_low (var_get_lst env)) - - - let var_redefine - ?hide - ?dump - ?short_desc - ?cli - ?arg_help - ?group - name - dflt = - if Schema.mem schema name then - begin - (* TODO: look suspsicious, we want to memorize dflt not dflt () *) - Schema.set schema env ~context:ODefault name (dflt ()); - fun () -> var_get name - end - else - begin - var_define - ?hide - ?dump - ?short_desc - ?cli - ?arg_help - ?group - name - dflt - end - - - let var_ignore (_: unit -> string) = () - - - let print_hidden = - var_define - ~hide:true - ~dump:false - ~cli:CLIAuto - ~arg_help:"Print even non-printable variable. (debug)" - "print_hidden" - (fun () -> "false") - - - let var_all () = - List.rev - (Schema.fold - (fun acc nm def _ -> - if not def.hide || bool_of_string (print_hidden ()) then - nm :: acc - else - acc) - [] - schema) - - - let default_filename = in_srcdir "setup.data" - - - let load ~ctxt ?(allow_empty=false) ?(filename=default_filename) () = - let open OASISFileSystem in - env_from_file := - let repr_filename = ctxt.srcfs#string_of_filename filename in - if ctxt.srcfs#file_exists filename then begin - let buf = Buffer.create 13 in - defer_close - (ctxt.srcfs#open_in ~mode:binary_in filename) - (read_all buf); - defer_close - (ctxt.srcfs#open_in ~mode:binary_in filename) - (fun rdr -> - OASISMessage.info ~ctxt "Loading environment from %S." repr_filename; - BaseEnvLight.load ~allow_empty - ~filename:(repr_filename) - ~stream:(stream_of_reader rdr) - ()) - end else if allow_empty then begin - BaseEnvLight.MapString.empty - end else begin - failwith - (Printf.sprintf - (f_ "Unable to load environment, the file '%s' doesn't exist.") - repr_filename) - end - - - let unload () = - env_from_file := MapString.empty; - Data.clear env - - - let dump ~ctxt ?(filename=default_filename) () = - let open OASISFileSystem in - defer_close - (ctxt.OASISContext.srcfs#open_out ~mode:binary_out filename) - (fun wrtr -> - let buf = Buffer.create 63 in - let output nm value = - Buffer.add_string buf (Printf.sprintf "%s=%S\n" nm value) - in - let mp_todo = - (* Dump data from schema *) - Schema.fold - (fun mp_todo nm def _ -> - if def.dump then begin - try - output nm (Schema.get schema env nm) - with Not_set _ -> - () - end; - MapString.remove nm mp_todo) - !env_from_file - schema - in - (* Dump data defined outside of schema *) - MapString.iter output mp_todo; - wrtr#output buf) - - let print () = - let printable_vars = - Schema.fold - (fun acc nm def short_descr_opt -> - if not def.hide || bool_of_string (print_hidden ()) then - begin - try - let value = Schema.get schema env nm in - let txt = - match short_descr_opt with - | Some s -> s () - | None -> nm - in - (txt, value) :: acc - with Not_set _ -> - acc - end - else - acc) - [] - schema - in - let max_length = - List.fold_left max 0 - (List.rev_map String.length - (List.rev_map fst printable_vars)) - in - let dot_pad str = String.make ((max_length - (String.length str)) + 3) '.' in - Printf.printf "\nConfiguration:\n"; - List.iter - (fun (name, value) -> - Printf.printf "%s: %s" name (dot_pad name); - if value = "" then - Printf.printf "\n" - else - Printf.printf " %s\n" value) - (List.rev printable_vars); - Printf.printf "\n%!" - - - let args () = - let arg_concat = OASISUtils.varname_concat ~hyphen:'-' in - [ - "--override", - Arg.Tuple - ( - let rvr = ref "" - in - let rvl = ref "" - in - [ - Arg.Set_string rvr; - Arg.Set_string rvl; - Arg.Unit - (fun () -> - Schema.set - schema - env - ~context:OCommandLine - !rvr - !rvl) - ] - ), - "var+val Override any configuration variable."; - - ] - @ - List.flatten - (Schema.fold - (fun acc name def short_descr_opt -> - let var_set s = - Schema.set - schema - env - ~context:OCommandLine - name - s - in - - let arg_name = - OASISUtils.varname_of_string ~hyphen:'-' name - in - - let hlp = - match short_descr_opt with - | Some txt -> txt () - | None -> "" - in - - let arg_hlp = - match def.arg_help with - | Some s -> s - | None -> "str" - in - - let default_value = - try - Printf.sprintf - (f_ " [%s]") - (Schema.get - schema - env - name) - with Not_set _ -> - "" - in - - let args = - match def.cli with - | CLINone -> - [] - | CLIAuto -> - [ - arg_concat "--" arg_name, - Arg.String var_set, - Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value - ] - | CLIWith -> - [ - arg_concat "--with-" arg_name, - Arg.String var_set, - Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value - ] - | CLIEnable -> - let dflt = - if default_value = " [true]" then - s_ " [default: enabled]" - else - s_ " [default: disabled]" - in - [ - arg_concat "--enable-" arg_name, - Arg.Unit (fun () -> var_set "true"), - Printf.sprintf (f_ " %s%s") hlp dflt; - - arg_concat "--disable-" arg_name, - Arg.Unit (fun () -> var_set "false"), - Printf.sprintf (f_ " %s%s") hlp dflt - ] - | CLIUser lst -> - lst - in - args :: acc) - [] - schema) -end - -module BaseArgExt = struct -(* # 22 "src/base/BaseArgExt.ml" *) - - - open OASISUtils - open OASISGettext - - - let parse argv args = - (* Simulate command line for Arg *) - let current = - ref 0 - in - - try - Arg.parse_argv - ~current:current - (Array.concat [[|"none"|]; argv]) - (Arg.align args) - (failwithf (f_ "Don't know what to do with arguments: '%s'")) - (s_ "configure options:") - with - | Arg.Help txt -> - print_endline txt; - exit 0 - | Arg.Bad txt -> - prerr_endline txt; - exit 1 -end - -module BaseCheck = struct -(* # 22 "src/base/BaseCheck.ml" *) - - - open BaseEnv - open BaseMessage - open OASISUtils - open OASISGettext - - - let prog_best prg prg_lst = - var_redefine - prg - (fun () -> - let alternate = - List.fold_left - (fun res e -> - match res with - | Some _ -> - res - | None -> - try - Some (OASISFileUtil.which ~ctxt:!BaseContext.default e) - with Not_found -> - None) - None - prg_lst - in - match alternate with - | Some prg -> prg - | None -> raise Not_found) - - - let prog prg = - prog_best prg [prg] - - - let prog_opt prg = - prog_best prg [prg^".opt"; prg] - - - let ocamlfind = - prog "ocamlfind" - - - let version - var_prefix - cmp - fversion - () = - (* Really compare version provided *) - let var = - var_prefix^"_version_"^(OASISVersion.varname_of_comparator cmp) - in - var_redefine - ~hide:true - var - (fun () -> - let version_str = - match fversion () with - | "[Distributed with OCaml]" -> - begin - try - (var_get "ocaml_version") - with Not_found -> - warning - (f_ "Variable ocaml_version not defined, fallback \ - to default"); - Sys.ocaml_version - end - | res -> - res - in - let version = - OASISVersion.version_of_string version_str - in - if OASISVersion.comparator_apply version cmp then - version_str - else - failwithf - (f_ "Cannot satisfy version constraint on %s: %s (version: %s)") - var_prefix - (OASISVersion.string_of_comparator cmp) - version_str) - () - - - let package_version pkg = - OASISExec.run_read_one_line ~ctxt:!BaseContext.default - (ocamlfind ()) - ["query"; "-format"; "%v"; pkg] - - - let package ?version_comparator pkg () = - let var = - OASISUtils.varname_concat - "pkg_" - (OASISUtils.varname_of_string pkg) - in - let findlib_dir pkg = - let dir = - OASISExec.run_read_one_line ~ctxt:!BaseContext.default - (ocamlfind ()) - ["query"; "-format"; "%d"; pkg] - in - if Sys.file_exists dir && Sys.is_directory dir then - dir - else - failwithf - (f_ "When looking for findlib package %s, \ - directory %s return doesn't exist") - pkg dir - in - let vl = - var_redefine - var - (fun () -> findlib_dir pkg) - () - in - ( - match version_comparator with - | Some ver_cmp -> - ignore - (version - var - ver_cmp - (fun _ -> package_version pkg) - ()) - | None -> - () - ); - vl -end - -module BaseOCamlcConfig = struct -(* # 22 "src/base/BaseOCamlcConfig.ml" *) - - - open BaseEnv - open OASISUtils - open OASISGettext - - - module SMap = Map.Make(String) - - - let ocamlc = - BaseCheck.prog_opt "ocamlc" - - - let ocamlc_config_map = - (* Map name to value for ocamlc -config output - (name ^": "^value) - *) - let rec split_field mp lst = - match lst with - | line :: tl -> - let mp = - try - let pos_semicolon = - String.index line ':' - in - if pos_semicolon > 1 then - ( - let name = - String.sub line 0 pos_semicolon - in - let linelen = - String.length line - in - let value = - if linelen > pos_semicolon + 2 then - String.sub - line - (pos_semicolon + 2) - (linelen - pos_semicolon - 2) - else - "" - in - SMap.add name value mp - ) - else - ( - mp - ) - with Not_found -> - ( - mp - ) - in - split_field mp tl - | [] -> - mp - in - - let cache = - lazy - (var_protect - (Marshal.to_string - (split_field - SMap.empty - (OASISExec.run_read_output - ~ctxt:!BaseContext.default - (ocamlc ()) ["-config"])) - [])) - in - var_redefine - "ocamlc_config_map" - ~hide:true - ~dump:false - (fun () -> - (* TODO: update if ocamlc change !!! *) - Lazy.force cache) - - - let var_define nm = - (* Extract data from ocamlc -config *) - let avlbl_config_get () = - Marshal.from_string - (ocamlc_config_map ()) - 0 - in - let chop_version_suffix s = - try - String.sub s 0 (String.index s '+') - with _ -> - s - in - - let nm_config, value_config = - match nm with - | "ocaml_version" -> - "version", chop_version_suffix - | _ -> nm, (fun x -> x) - in - var_redefine - nm - (fun () -> - try - let map = - avlbl_config_get () - in - let value = - SMap.find nm_config map - in - value_config value - with Not_found -> - failwithf - (f_ "Cannot find field '%s' in '%s -config' output") - nm - (ocamlc ())) - -end - -module BaseStandardVar = struct -(* # 22 "src/base/BaseStandardVar.ml" *) - - - open OASISGettext - open OASISTypes - open BaseCheck - open BaseEnv - - - let ocamlfind = BaseCheck.ocamlfind - let ocamlc = BaseOCamlcConfig.ocamlc - let ocamlopt = prog_opt "ocamlopt" - let ocamlbuild = prog "ocamlbuild" - - - (**/**) - let rpkg = - ref None - - - let pkg_get () = - match !rpkg with - | Some pkg -> pkg - | None -> failwith (s_ "OASIS Package is not set") - - - let var_cond = ref [] - - - let var_define_cond ~since_version f dflt = - let holder = ref (fun () -> dflt) in - let since_version = - OASISVersion.VGreaterEqual (OASISVersion.version_of_string since_version) - in - var_cond := - (fun ver -> - if OASISVersion.comparator_apply ver since_version then - holder := f ()) :: !var_cond; - fun () -> !holder () - - - (**/**) - - - let pkg_name = - var_define - ~short_desc:(fun () -> s_ "Package name") - "pkg_name" - (fun () -> (pkg_get ()).name) - - - let pkg_version = - var_define - ~short_desc:(fun () -> s_ "Package version") - "pkg_version" - (fun () -> - (OASISVersion.string_of_version (pkg_get ()).version)) - - - let c = BaseOCamlcConfig.var_define - - - let os_type = c "os_type" - let system = c "system" - let architecture = c "architecture" - let ccomp_type = c "ccomp_type" - let ocaml_version = c "ocaml_version" - - - (* TODO: Check standard variable presence at runtime *) - - - let standard_library_default = c "standard_library_default" - let standard_library = c "standard_library" - let standard_runtime = c "standard_runtime" - let bytecomp_c_compiler = c "bytecomp_c_compiler" - let native_c_compiler = c "native_c_compiler" - let model = c "model" - let ext_obj = c "ext_obj" - let ext_asm = c "ext_asm" - let ext_lib = c "ext_lib" - let ext_dll = c "ext_dll" - let default_executable_name = c "default_executable_name" - let systhread_supported = c "systhread_supported" - - - let flexlink = - BaseCheck.prog "flexlink" - - - let flexdll_version = - var_define - ~short_desc:(fun () -> "FlexDLL version (Win32)") - "flexdll_version" - (fun () -> - let lst = - OASISExec.run_read_output ~ctxt:!BaseContext.default - (flexlink ()) ["-help"] - in - match lst with - | line :: _ -> - Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver) - | [] -> - raise Not_found) - - - (**/**) - let p name hlp dflt = - var_define - ~short_desc:hlp - ~cli:CLIAuto - ~arg_help:"dir" - name - dflt - - - let (/) a b = - if os_type () = Sys.os_type then - Filename.concat a b - else if os_type () = "Unix" || os_type () = "Cygwin" then - OASISUnixPath.concat a b - else - OASISUtils.failwithf (f_ "Cannot handle os_type %s filename concat") - (os_type ()) - (**/**) - - - let prefix = - p "prefix" - (fun () -> s_ "Install architecture-independent files dir") - (fun () -> - match os_type () with - | "Win32" -> - let program_files = - Sys.getenv "PROGRAMFILES" - in - program_files/(pkg_name ()) - | _ -> - "/usr/local") - - - let exec_prefix = - p "exec_prefix" - (fun () -> s_ "Install architecture-dependent files in dir") - (fun () -> "$prefix") - - - let bindir = - p "bindir" - (fun () -> s_ "User executables") - (fun () -> "$exec_prefix"/"bin") - - - let sbindir = - p "sbindir" - (fun () -> s_ "System admin executables") - (fun () -> "$exec_prefix"/"sbin") - - - let libexecdir = - p "libexecdir" - (fun () -> s_ "Program executables") - (fun () -> "$exec_prefix"/"libexec") - - - let sysconfdir = - p "sysconfdir" - (fun () -> s_ "Read-only single-machine data") - (fun () -> "$prefix"/"etc") - - - let sharedstatedir = - p "sharedstatedir" - (fun () -> s_ "Modifiable architecture-independent data") - (fun () -> "$prefix"/"com") - - - let localstatedir = - p "localstatedir" - (fun () -> s_ "Modifiable single-machine data") - (fun () -> "$prefix"/"var") - - - let libdir = - p "libdir" - (fun () -> s_ "Object code libraries") - (fun () -> "$exec_prefix"/"lib") - - - let datarootdir = - p "datarootdir" - (fun () -> s_ "Read-only arch-independent data root") - (fun () -> "$prefix"/"share") - - - let datadir = - p "datadir" - (fun () -> s_ "Read-only architecture-independent data") - (fun () -> "$datarootdir") - - - let infodir = - p "infodir" - (fun () -> s_ "Info documentation") - (fun () -> "$datarootdir"/"info") - - - let localedir = - p "localedir" - (fun () -> s_ "Locale-dependent data") - (fun () -> "$datarootdir"/"locale") - - - let mandir = - p "mandir" - (fun () -> s_ "Man documentation") - (fun () -> "$datarootdir"/"man") - - - let docdir = - p "docdir" - (fun () -> s_ "Documentation root") - (fun () -> "$datarootdir"/"doc"/"$pkg_name") - - - let htmldir = - p "htmldir" - (fun () -> s_ "HTML documentation") - (fun () -> "$docdir") - - - let dvidir = - p "dvidir" - (fun () -> s_ "DVI documentation") - (fun () -> "$docdir") - - - let pdfdir = - p "pdfdir" - (fun () -> s_ "PDF documentation") - (fun () -> "$docdir") - - - let psdir = - p "psdir" - (fun () -> s_ "PS documentation") - (fun () -> "$docdir") - - - let destdir = - p "destdir" - (fun () -> s_ "Prepend a path when installing package") - (fun () -> - raise - (PropList.Not_set - ("destdir", - Some (s_ "undefined by construct")))) - - - let findlib_version = - var_define - "findlib_version" - (fun () -> - BaseCheck.package_version "findlib") - - - let is_native = - var_define - "is_native" - (fun () -> - try - let _s: string = - ocamlopt () - in - "true" - with PropList.Not_set _ -> - let _s: string = - ocamlc () - in - "false") - - - let ext_program = - var_define - "suffix_program" - (fun () -> - match os_type () with - | "Win32" | "Cygwin" -> ".exe" - | _ -> "") - - - let rm = - var_define - ~short_desc:(fun () -> s_ "Remove a file.") - "rm" - (fun () -> - match os_type () with - | "Win32" -> "del" - | _ -> "rm -f") - - - let rmdir = - var_define - ~short_desc:(fun () -> s_ "Remove a directory.") - "rmdir" - (fun () -> - match os_type () with - | "Win32" -> "rd" - | _ -> "rm -rf") - - - let debug = - var_define - ~short_desc:(fun () -> s_ "Turn ocaml debug flag on") - ~cli:CLIEnable - "debug" - (fun () -> "true") - - - let profile = - var_define - ~short_desc:(fun () -> s_ "Turn ocaml profile flag on") - ~cli:CLIEnable - "profile" - (fun () -> "false") - - - let tests = - var_define_cond ~since_version:"0.3" - (fun () -> - var_define - ~short_desc:(fun () -> - s_ "Compile tests executable and library and run them") - ~cli:CLIEnable - "tests" - (fun () -> "false")) - "true" - - - let docs = - var_define_cond ~since_version:"0.3" - (fun () -> - var_define - ~short_desc:(fun () -> s_ "Create documentations") - ~cli:CLIEnable - "docs" - (fun () -> "true")) - "true" - - - let native_dynlink = - var_define - ~short_desc:(fun () -> s_ "Compiler support generation of .cmxs.") - ~cli:CLINone - "native_dynlink" - (fun () -> - let res = - let ocaml_lt_312 () = - OASISVersion.comparator_apply - (OASISVersion.version_of_string (ocaml_version ())) - (OASISVersion.VLesser - (OASISVersion.version_of_string "3.12.0")) - in - let flexdll_lt_030 () = - OASISVersion.comparator_apply - (OASISVersion.version_of_string (flexdll_version ())) - (OASISVersion.VLesser - (OASISVersion.version_of_string "0.30")) - in - let has_native_dynlink = - let ocamlfind = ocamlfind () in - try - let fn = - OASISExec.run_read_one_line - ~ctxt:!BaseContext.default - ocamlfind - ["query"; "-predicates"; "native"; "dynlink"; - "-format"; "%d/%a"] - in - Sys.file_exists fn - with _ -> - false - in - if not has_native_dynlink then - false - else if ocaml_lt_312 () then - false - else if (os_type () = "Win32" || os_type () = "Cygwin") - && flexdll_lt_030 () then - begin - BaseMessage.warning - (f_ ".cmxs generation disabled because FlexDLL needs to be \ - at least 0.30. Please upgrade FlexDLL from %s to 0.30.") - (flexdll_version ()); - false - end - else - true - in - string_of_bool res) - - - let init pkg = - rpkg := Some pkg; - List.iter (fun f -> f pkg.oasis_version) !var_cond - -end - -module BaseFileAB = struct -(* # 22 "src/base/BaseFileAB.ml" *) - - - open BaseEnv - open OASISGettext - open BaseMessage - open OASISContext - - - let to_filename fn = - if not (Filename.check_suffix fn ".ab") then - warning (f_ "File '%s' doesn't have '.ab' extension") fn; - OASISFileSystem.of_unix_filename (Filename.chop_extension fn) - - - let replace ~ctxt fn_lst = - let open OASISFileSystem in - let ibuf, obuf = Buffer.create 13, Buffer.create 13 in - List.iter - (fun fn -> - Buffer.clear ibuf; Buffer.clear obuf; - defer_close - (ctxt.srcfs#open_in (of_unix_filename fn)) - (read_all ibuf); - Buffer.add_string obuf (var_expand (Buffer.contents ibuf)); - defer_close - (ctxt.srcfs#open_out (to_filename fn)) - (fun wrtr -> wrtr#output obuf)) - fn_lst -end - -module BaseLog = struct -(* # 22 "src/base/BaseLog.ml" *) - - - open OASISUtils - open OASISContext - open OASISGettext - open OASISFileSystem - - - let default_filename = in_srcdir "setup.log" - - - let load ~ctxt () = - let module SetTupleString = - Set.Make - (struct - type t = string * string - let compare (s11, s12) (s21, s22) = - match String.compare s11 s21 with - | 0 -> String.compare s12 s22 - | n -> n - end) - in - if ctxt.srcfs#file_exists default_filename then begin - defer_close - (ctxt.srcfs#open_in default_filename) - (fun rdr -> - let line = ref 1 in - let lxr = Genlex.make_lexer [] (stream_of_reader rdr) in - let rec read_aux (st, lst) = - match Stream.npeek 2 lxr with - | [Genlex.String e; Genlex.String d] -> - let t = e, d in - Stream.junk lxr; Stream.junk lxr; - if SetTupleString.mem t st then - read_aux (st, lst) - else - read_aux (SetTupleString.add t st, t :: lst) - | [] -> List.rev lst - | _ -> - failwithf - (f_ "Malformed log file '%s' at line %d") - (ctxt.srcfs#string_of_filename default_filename) - !line - in - read_aux (SetTupleString.empty, [])) - end else begin - [] - end - - - let register ~ctxt event data = - defer_close - (ctxt.srcfs#open_out - ~mode:[Open_append; Open_creat; Open_text] - ~perm:0o644 - default_filename) - (fun wrtr -> - let buf = Buffer.create 13 in - Printf.bprintf buf "%S %S\n" event data; - wrtr#output buf) - - - let unregister ~ctxt event data = - let lst = load ~ctxt () in - let buf = Buffer.create 13 in - List.iter - (fun (e, d) -> - if e <> event || d <> data then - Printf.bprintf buf "%S %S\n" e d) - lst; - if Buffer.length buf > 0 then - defer_close - (ctxt.srcfs#open_out default_filename) - (fun wrtr -> wrtr#output buf) - else - ctxt.srcfs#remove default_filename - - - let filter ~ctxt events = - let st_events = SetString.of_list events in - List.filter - (fun (e, _) -> SetString.mem e st_events) - (load ~ctxt ()) - - - let exists ~ctxt event data = - List.exists - (fun v -> (event, data) = v) - (load ~ctxt ()) -end - -module BaseBuilt = struct -(* # 22 "src/base/BaseBuilt.ml" *) - - - open OASISTypes - open OASISGettext - open BaseStandardVar - open BaseMessage - - - type t = - | BExec (* Executable *) - | BExecLib (* Library coming with executable *) - | BLib (* Library *) - | BObj (* Library *) - | BDoc (* Document *) - - - let to_log_event_file t nm = - "built_"^ - (match t with - | BExec -> "exec" - | BExecLib -> "exec_lib" - | BLib -> "lib" - | BObj -> "obj" - | BDoc -> "doc")^ - "_"^nm - - - let to_log_event_done t nm = - "is_"^(to_log_event_file t nm) - - - let register ~ctxt t nm lst = - BaseLog.register ~ctxt (to_log_event_done t nm) "true"; - List.iter - (fun alt -> - let registered = - List.fold_left - (fun registered fn -> - if OASISFileUtil.file_exists_case fn then begin - BaseLog.register ~ctxt - (to_log_event_file t nm) - (if Filename.is_relative fn then - Filename.concat (Sys.getcwd ()) fn - else - fn); - true - end else begin - registered - end) - false - alt - in - if not registered then - warning - (f_ "Cannot find an existing alternative files among: %s") - (String.concat (s_ ", ") alt)) - lst - - - let unregister ~ctxt t nm = - List.iter - (fun (e, d) -> BaseLog.unregister ~ctxt e d) - (BaseLog.filter ~ctxt [to_log_event_file t nm; to_log_event_done t nm]) - - - let fold ~ctxt t nm f acc = - List.fold_left - (fun acc (_, fn) -> - if OASISFileUtil.file_exists_case fn then begin - f acc fn - end else begin - warning - (f_ "File '%s' has been marked as built \ - for %s but doesn't exist") - fn - (Printf.sprintf - (match t with - | BExec | BExecLib -> (f_ "executable %s") - | BLib -> (f_ "library %s") - | BObj -> (f_ "object %s") - | BDoc -> (f_ "documentation %s")) - nm); - acc - end) - acc - (BaseLog.filter ~ctxt [to_log_event_file t nm]) - - - let is_built ~ctxt t nm = - List.fold_left - (fun _ (_, d) -> try bool_of_string d with _ -> false) - false - (BaseLog.filter ~ctxt [to_log_event_done t nm]) - - - let of_executable ffn (cs, bs, exec) = - let unix_exec_is, unix_dll_opt = - OASISExecutable.unix_exec_is - (cs, bs, exec) - (fun () -> - bool_of_string - (is_native ())) - ext_dll - ext_program - in - let evs = - (BExec, cs.cs_name, [[ffn unix_exec_is]]) - :: - (match unix_dll_opt with - | Some fn -> - [BExecLib, cs.cs_name, [[ffn fn]]] - | None -> - []) - in - evs, - unix_exec_is, - unix_dll_opt - - - let of_library ffn (cs, bs, lib) = - let unix_lst = - OASISLibrary.generated_unix_files - ~ctxt:!BaseContext.default - ~source_file_exists:(fun fn -> - OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn)) - ~is_native:(bool_of_string (is_native ())) - ~has_native_dynlink:(bool_of_string (native_dynlink ())) - ~ext_lib:(ext_lib ()) - ~ext_dll:(ext_dll ()) - (cs, bs, lib) - in - let evs = - [BLib, - cs.cs_name, - List.map (List.map ffn) unix_lst] - in - evs, unix_lst - - - let of_object ffn (cs, bs, obj) = - let unix_lst = - OASISObject.generated_unix_files - ~ctxt:!BaseContext.default - ~source_file_exists:(fun fn -> - OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn)) - ~is_native:(bool_of_string (is_native ())) - (cs, bs, obj) - in - let evs = - [BObj, - cs.cs_name, - List.map (List.map ffn) unix_lst] - in - evs, unix_lst - -end - -module BaseCustom = struct -(* # 22 "src/base/BaseCustom.ml" *) - - - open BaseEnv - open BaseMessage - open OASISTypes - open OASISGettext - - - let run cmd args extra_args = - OASISExec.run ~ctxt:!BaseContext.default ~quote:false - (var_expand cmd) - (List.map - var_expand - (args @ (Array.to_list extra_args))) - - - let hook ?(failsafe=false) cstm f e = - let optional_command lst = - let printer = - function - | Some (cmd, args) -> String.concat " " (cmd :: args) - | None -> s_ "No command" - in - match - var_choose - ~name:(s_ "Pre/Post Command") - ~printer - lst with - | Some (cmd, args) -> - begin - try - run cmd args [||] - with e when failsafe -> - warning - (f_ "Command '%s' fail with error: %s") - (String.concat " " (cmd :: args)) - (match e with - | Failure msg -> msg - | e -> Printexc.to_string e) - end - | None -> - () - in - let res = - optional_command cstm.pre_command; - f e - in - optional_command cstm.post_command; - res -end - -module BaseDynVar = struct -(* # 22 "src/base/BaseDynVar.ml" *) - - - open OASISTypes - open OASISGettext - open BaseEnv - open BaseBuilt - - - let init ~ctxt pkg = - (* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *) - (* TODO: provide compile option for library libary_byte_args_VARNAME... *) - List.iter - (function - | Executable (cs, bs, _) -> - if var_choose bs.bs_build then - var_ignore - (var_redefine - (* We don't save this variable *) - ~dump:false - ~short_desc:(fun () -> - Printf.sprintf - (f_ "Filename of executable '%s'") - cs.cs_name) - (OASISUtils.varname_of_string cs.cs_name) - (fun () -> - let fn_opt = - fold ~ctxt BExec cs.cs_name (fun _ fn -> Some fn) None - in - match fn_opt with - | Some fn -> fn - | None -> - raise - (PropList.Not_set - (cs.cs_name, - Some (Printf.sprintf - (f_ "Executable '%s' not yet built.") - cs.cs_name))))) - - | Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ -> - ()) - pkg.sections -end - -module BaseTest = struct -(* # 22 "src/base/BaseTest.ml" *) - - - open BaseEnv - open BaseMessage - open OASISTypes - open OASISGettext - - - let test ~ctxt lst pkg extra_args = - - let one_test (failure, n) (test_plugin, cs, test) = - if var_choose - ~name:(Printf.sprintf - (f_ "test %s run") - cs.cs_name) - ~printer:string_of_bool - test.test_run then - begin - let () = info (f_ "Running test '%s'") cs.cs_name in - let back_cwd = - match test.test_working_directory with - | Some dir -> - let cwd = Sys.getcwd () in - let chdir d = - info (f_ "Changing directory to '%s'") d; - Sys.chdir d - in - chdir dir; - fun () -> chdir cwd - - | None -> - fun () -> () - in - try - let failure_percent = - BaseCustom.hook - test.test_custom - (test_plugin ~ctxt pkg (cs, test)) - extra_args - in - back_cwd (); - (failure_percent +. failure, n + 1) - with e -> - begin - back_cwd (); - raise e - end - end - else - begin - info (f_ "Skipping test '%s'") cs.cs_name; - (failure, n) - end - in - let failed, n = List.fold_left one_test (0.0, 0) lst in - let failure_percent = if n = 0 then 0.0 else failed /. (float_of_int n) in - let msg = - Printf.sprintf - (f_ "Tests had a %.2f%% failure rate") - (100. *. failure_percent) - in - if failure_percent > 0.0 then - failwith msg - else - info "%s" msg; - - (* Possible explanation why the tests where not run. *) - if OASISFeatures.package_test OASISFeatures.flag_tests pkg && - not (bool_of_string (BaseStandardVar.tests ())) && - lst <> [] then - BaseMessage.warning - "Tests are turned off, consider enabling with \ - 'ocaml setup.ml -configure --enable-tests'" -end - -module BaseDoc = struct -(* # 22 "src/base/BaseDoc.ml" *) - - - open BaseEnv - open BaseMessage - open OASISTypes - open OASISGettext - - - let doc ~ctxt lst pkg extra_args = - - let one_doc (doc_plugin, cs, doc) = - if var_choose - ~name:(Printf.sprintf - (f_ "documentation %s build") - cs.cs_name) - ~printer:string_of_bool - doc.doc_build then - begin - info (f_ "Building documentation '%s'") cs.cs_name; - BaseCustom.hook - doc.doc_custom - (doc_plugin ~ctxt pkg (cs, doc)) - extra_args - end - in - List.iter one_doc lst; - - if OASISFeatures.package_test OASISFeatures.flag_docs pkg && - not (bool_of_string (BaseStandardVar.docs ())) && - lst <> [] then - BaseMessage.warning - "Docs are turned off, consider enabling with \ - 'ocaml setup.ml -configure --enable-docs'" -end - -module BaseSetup = struct -(* # 22 "src/base/BaseSetup.ml" *) - - open OASISContext - open BaseEnv - open BaseMessage - open OASISTypes - open OASISGettext - open OASISUtils - - - type std_args_fun = - ctxt:OASISContext.t -> package -> string array -> unit - - - type ('a, 'b) section_args_fun = - name * - (ctxt:OASISContext.t -> - package -> - (common_section * 'a) -> - string array -> - 'b) - - - type t = - { - configure: std_args_fun; - build: std_args_fun; - doc: ((doc, unit) section_args_fun) list; - test: ((test, float) section_args_fun) list; - install: std_args_fun; - uninstall: std_args_fun; - clean: std_args_fun list; - clean_doc: (doc, unit) section_args_fun list; - clean_test: (test, unit) section_args_fun list; - distclean: std_args_fun list; - distclean_doc: (doc, unit) section_args_fun list; - distclean_test: (test, unit) section_args_fun list; - package: package; - oasis_fn: string option; - oasis_version: string; - oasis_digest: Digest.t option; - oasis_exec: string option; - oasis_setup_args: string list; - setup_update: bool; - } - - - (* Associate a plugin function with data from package *) - let join_plugin_sections filter_map lst = - List.rev - (List.fold_left - (fun acc sct -> - match filter_map sct with - | Some e -> - e :: acc - | None -> - acc) - [] - lst) - - - (* Search for plugin data associated with a section name *) - let lookup_plugin_section plugin action nm lst = - try - List.assoc nm lst - with Not_found -> - failwithf - (f_ "Cannot find plugin %s matching section %s for %s action") - plugin - nm - action - - - let configure ~ctxt t args = - (* Run configure *) - BaseCustom.hook - t.package.conf_custom - (fun () -> - (* Reload if preconf has changed it *) - begin - try - unload (); - load ~ctxt (); - with _ -> - () - end; - - (* Run plugin's configure *) - t.configure ~ctxt t.package args; - - (* Dump to allow postconf to change it *) - dump ~ctxt ()) - (); - - (* Reload environment *) - unload (); - load ~ctxt (); - - (* Save environment *) - print (); - - (* Replace data in file *) - BaseFileAB.replace ~ctxt t.package.files_ab - - - let build ~ctxt t args = - BaseCustom.hook - t.package.build_custom - (t.build ~ctxt t.package) - args - - - let doc ~ctxt t args = - BaseDoc.doc - ~ctxt - (join_plugin_sections - (function - | Doc (cs, e) -> - Some - (lookup_plugin_section - "documentation" - (s_ "build") - cs.cs_name - t.doc, - cs, - e) - | _ -> - None) - t.package.sections) - t.package - args - - - let test ~ctxt t args = - BaseTest.test - ~ctxt - (join_plugin_sections - (function - | Test (cs, e) -> - Some - (lookup_plugin_section - "test" - (s_ "run") - cs.cs_name - t.test, - cs, - e) - | _ -> - None) - t.package.sections) - t.package - args - - - let all ~ctxt t args = - let rno_doc = ref false in - let rno_test = ref false in - let arg_rest = ref [] in - Arg.parse_argv - ~current:(ref 0) - (Array.of_list - ((Sys.executable_name^" all") :: - (Array.to_list args))) - [ - "-no-doc", - Arg.Set rno_doc, - s_ "Don't run doc target"; - - "-no-test", - Arg.Set rno_test, - s_ "Don't run test target"; - - "--", - Arg.Rest (fun arg -> arg_rest := arg :: !arg_rest), - s_ "All arguments for configure."; - ] - (failwithf (f_ "Don't know what to do with '%s'")) - ""; - - info "Running configure step"; - configure ~ctxt t (Array.of_list (List.rev !arg_rest)); - - info "Running build step"; - build ~ctxt t [||]; - - (* Load setup.log dynamic variables *) - BaseDynVar.init ~ctxt t.package; - - if not !rno_doc then begin - info "Running doc step"; - doc ~ctxt t [||] - end else begin - info "Skipping doc step" - end; - if not !rno_test then begin - info "Running test step"; - test ~ctxt t [||] - end else begin - info "Skipping test step" - end - - - let install ~ctxt t args = - BaseCustom.hook t.package.install_custom (t.install ~ctxt t.package) args - - - let uninstall ~ctxt t args = - BaseCustom.hook t.package.uninstall_custom (t.uninstall ~ctxt t.package) args - - - let reinstall ~ctxt t args = - uninstall ~ctxt t args; - install ~ctxt t args - - - let clean, distclean = - let failsafe f a = - try - f a - with e -> - warning - (f_ "Action fail with error: %s") - (match e with - | Failure msg -> msg - | e -> Printexc.to_string e) - in - - let generic_clean ~ctxt t cstm mains docs tests args = - BaseCustom.hook - ~failsafe:true - cstm - (fun () -> - (* Clean section *) - List.iter - (function - | Test (cs, test) -> - let f = - try - List.assoc cs.cs_name tests - with Not_found -> - fun ~ctxt:_ _ _ _ -> () - in - failsafe (f ~ctxt t.package (cs, test)) args - | Doc (cs, doc) -> - let f = - try - List.assoc cs.cs_name docs - with Not_found -> - fun ~ctxt:_ _ _ _ -> () - in - failsafe (f ~ctxt t.package (cs, doc)) args - | Library _ | Object _ | Executable _ | Flag _ | SrcRepo _ -> ()) - t.package.sections; - (* Clean whole package *) - List.iter (fun f -> failsafe (f ~ctxt t.package) args) mains) - () - in - - let clean ~ctxt t args = - generic_clean - ~ctxt - t - t.package.clean_custom - t.clean - t.clean_doc - t.clean_test - args - in - - let distclean ~ctxt t args = - (* Call clean *) - clean ~ctxt t args; - - (* Call distclean code *) - generic_clean - ~ctxt - t - t.package.distclean_custom - t.distclean - t.distclean_doc - t.distclean_test - args; - - (* Remove generated source files. *) - List.iter - (fun fn -> - if ctxt.srcfs#file_exists fn then begin - info (f_ "Remove '%s'") (ctxt.srcfs#string_of_filename fn); - ctxt.srcfs#remove fn - end) - ([BaseEnv.default_filename; BaseLog.default_filename] - @ (List.rev_map BaseFileAB.to_filename t.package.files_ab)) - in - - clean, distclean - - - let version ~ctxt:_ (t: t) _ = print_endline t.oasis_version - - - let update_setup_ml, no_update_setup_ml_cli = - let b = ref true in - b, - ("-no-update-setup-ml", - Arg.Clear b, - s_ " Don't try to update setup.ml, even if _oasis has changed.") - - (* TODO: srcfs *) - let default_oasis_fn = "_oasis" - - - let update_setup_ml t = - let oasis_fn = - match t.oasis_fn with - | Some fn -> fn - | None -> default_oasis_fn - in - let oasis_exec = - match t.oasis_exec with - | Some fn -> fn - | None -> "oasis" - in - let ocaml = - Sys.executable_name - in - let setup_ml, args = - match Array.to_list Sys.argv with - | setup_ml :: args -> - setup_ml, args - | [] -> - failwith - (s_ "Expecting non-empty command line arguments.") - in - let ocaml, setup_ml = - if Sys.executable_name = Sys.argv.(0) then - (* We are not running in standard mode, probably the script - * is precompiled. - *) - "ocaml", "setup.ml" - else - ocaml, setup_ml - in - let no_update_setup_ml_cli, _, _ = no_update_setup_ml_cli in - let do_update () = - let oasis_exec_version = - OASISExec.run_read_one_line - ~ctxt:!BaseContext.default - ~f_exit_code: - (function - | 0 -> - () - | 1 -> - failwithf - (f_ "Executable '%s' is probably an old version \ - of oasis (< 0.3.0), please update to version \ - v%s.") - oasis_exec t.oasis_version - | 127 -> - failwithf - (f_ "Cannot find executable '%s', please install \ - oasis v%s.") - oasis_exec t.oasis_version - | n -> - failwithf - (f_ "Command '%s version' exited with code %d.") - oasis_exec n) - oasis_exec ["version"] - in - if OASISVersion.comparator_apply - (OASISVersion.version_of_string oasis_exec_version) - (OASISVersion.VGreaterEqual - (OASISVersion.version_of_string t.oasis_version)) then - begin - (* We have a version >= for the executable oasis, proceed with - * update. - *) - (* TODO: delegate this check to 'oasis setup'. *) - if Sys.os_type = "Win32" then - failwithf - (f_ "It is not possible to update the running script \ - setup.ml on Windows. Please update setup.ml by \ - running '%s'.") - (String.concat " " (oasis_exec :: "setup" :: t.oasis_setup_args)) - else - begin - OASISExec.run - ~ctxt:!BaseContext.default - ~f_exit_code: - (fun n -> - if n <> 0 then - failwithf - (f_ "Unable to update setup.ml using '%s', \ - please fix the problem and retry.") - oasis_exec) - oasis_exec ("setup" :: t.oasis_setup_args); - OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args) - end - end - else - failwithf - (f_ "The version of '%s' (v%s) doesn't match the version of \ - oasis used to generate the %s file. Please install at \ - least oasis v%s.") - oasis_exec oasis_exec_version setup_ml t.oasis_version - in - - if !update_setup_ml then - begin - try - match t.oasis_digest with - | Some dgst -> - if Sys.file_exists oasis_fn && - dgst <> Digest.file default_oasis_fn then - begin - do_update (); - true - end - else - false - | None -> - false - with e -> - error - (f_ "Error when updating setup.ml. If you want to avoid this error, \ - you can bypass the update of %s by running '%s %s %s %s'") - setup_ml ocaml setup_ml no_update_setup_ml_cli - (String.concat " " args); - raise e - end - else - false - - - let setup t = - let catch_exn = ref true in - let act_ref = - ref (fun ~ctxt:_ _ -> - failwithf - (f_ "No action defined, run '%s %s -help'") - Sys.executable_name - Sys.argv.(0)) - - in - let extra_args_ref = ref [] in - let allow_empty_env_ref = ref false in - let arg_handle ?(allow_empty_env=false) act = - Arg.Tuple - [ - Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref); - Arg.Unit - (fun () -> - allow_empty_env_ref := allow_empty_env; - act_ref := act); - ] - in - try - let () = - Arg.parse - (Arg.align - ([ - "-configure", - arg_handle ~allow_empty_env:true configure, - s_ "[options*] Configure the whole build process."; - - "-build", - arg_handle build, - s_ "[options*] Build executables and libraries."; - - "-doc", - arg_handle doc, - s_ "[options*] Build documents."; - - "-test", - arg_handle test, - s_ "[options*] Run tests."; - - "-all", - arg_handle ~allow_empty_env:true all, - s_ "[options*] Run configure, build, doc and test targets."; - - "-install", - arg_handle install, - s_ "[options*] Install libraries, data, executables \ - and documents."; - - "-uninstall", - arg_handle uninstall, - s_ "[options*] Uninstall libraries, data, executables \ - and documents."; - - "-reinstall", - arg_handle reinstall, - s_ "[options*] Uninstall and install libraries, data, \ - executables and documents."; - - "-clean", - arg_handle ~allow_empty_env:true clean, - s_ "[options*] Clean files generated by a build."; - - "-distclean", - arg_handle ~allow_empty_env:true distclean, - s_ "[options*] Clean files generated by a build and configure."; - - "-version", - arg_handle ~allow_empty_env:true version, - s_ " Display version of OASIS used to generate this setup.ml."; - - "-no-catch-exn", - Arg.Clear catch_exn, - s_ " Don't catch exception, useful for debugging."; - ] - @ - (if t.setup_update then - [no_update_setup_ml_cli] - else - []) - @ (BaseContext.args ()))) - (failwithf (f_ "Don't know what to do with '%s'")) - (s_ "Setup and run build process current package\n") - in - - (* Instantiate the context. *) - let ctxt = !BaseContext.default in - - (* Build initial environment *) - load ~ctxt ~allow_empty:!allow_empty_env_ref (); - - (** Initialize flags *) - List.iter - (function - | Flag (cs, {flag_description = hlp; - flag_default = choices}) -> - begin - let apply ?short_desc () = - var_ignore - (var_define - ~cli:CLIEnable - ?short_desc - (OASISUtils.varname_of_string cs.cs_name) - (fun () -> - string_of_bool - (var_choose - ~name:(Printf.sprintf - (f_ "default value of flag %s") - cs.cs_name) - ~printer:string_of_bool - choices))) - in - match hlp with - | Some hlp -> apply ~short_desc:(fun () -> hlp) () - | None -> apply () - end - | _ -> - ()) - t.package.sections; - - BaseStandardVar.init t.package; - - BaseDynVar.init ~ctxt t.package; - - if not (t.setup_update && update_setup_ml t) then - !act_ref ~ctxt t (Array.of_list (List.rev !extra_args_ref)) - - with e when !catch_exn -> - error "%s" (Printexc.to_string e); - exit 1 - - -end - -module BaseCompat = struct -(* # 22 "src/base/BaseCompat.ml" *) - - (** Compatibility layer to provide a stable API inside setup.ml. - This layer allows OASIS to change in between minor versions - (e.g. 0.4.6 -> 0.4.7) but still provides a stable API inside setup.ml. This - enables to write functions that manipulate setup_t inside setup.ml. See - deps.ml for an example. - - The module opened by default will depend on the version of the _oasis. E.g. - if we have "OASISFormat: 0.3", the module Compat_0_3 will be opened and - the function Compat_0_3 will be called. If setup.ml is generated with the - -nocompat, no module will be opened. - - @author Sylvain Le Gall - *) - - module Compat_0_4 = - struct - let rctxt = ref !BaseContext.default - - module BaseSetup = - struct - module Original = BaseSetup - - open OASISTypes - - type std_args_fun = package -> string array -> unit - type ('a, 'b) section_args_fun = - name * (package -> (common_section * 'a) -> string array -> 'b) - type t = - { - configure: std_args_fun; - build: std_args_fun; - doc: ((doc, unit) section_args_fun) list; - test: ((test, float) section_args_fun) list; - install: std_args_fun; - uninstall: std_args_fun; - clean: std_args_fun list; - clean_doc: (doc, unit) section_args_fun list; - clean_test: (test, unit) section_args_fun list; - distclean: std_args_fun list; - distclean_doc: (doc, unit) section_args_fun list; - distclean_test: (test, unit) section_args_fun list; - package: package; - oasis_fn: string option; - oasis_version: string; - oasis_digest: Digest.t option; - oasis_exec: string option; - oasis_setup_args: string list; - setup_update: bool; - } - - let setup t = - let mk_std_args_fun f = - fun ~ctxt pkg args -> rctxt := ctxt; f pkg args - in - let mk_section_args_fun l = - List.map - (fun (nm, f) -> - nm, - (fun ~ctxt pkg sct args -> - rctxt := ctxt; - f pkg sct args)) - l - in - let t' = - { - Original. - configure = mk_std_args_fun t.configure; - build = mk_std_args_fun t.build; - doc = mk_section_args_fun t.doc; - test = mk_section_args_fun t.test; - install = mk_std_args_fun t.install; - uninstall = mk_std_args_fun t.uninstall; - clean = List.map mk_std_args_fun t.clean; - clean_doc = mk_section_args_fun t.clean_doc; - clean_test = mk_section_args_fun t.clean_test; - distclean = List.map mk_std_args_fun t.distclean; - distclean_doc = mk_section_args_fun t.distclean_doc; - distclean_test = mk_section_args_fun t.distclean_test; - - package = t.package; - oasis_fn = t.oasis_fn; - oasis_version = t.oasis_version; - oasis_digest = t.oasis_digest; - oasis_exec = t.oasis_exec; - oasis_setup_args = t.oasis_setup_args; - setup_update = t.setup_update; - } - in - Original.setup t' - - end - - let adapt_setup_t setup_t = - let module O = BaseSetup.Original in - let mk_std_args_fun f = fun pkg args -> f ~ctxt:!rctxt pkg args in - let mk_section_args_fun l = - List.map - (fun (nm, f) -> nm, (fun pkg sct args -> f ~ctxt:!rctxt pkg sct args)) - l - in - { - BaseSetup. - configure = mk_std_args_fun setup_t.O.configure; - build = mk_std_args_fun setup_t.O.build; - doc = mk_section_args_fun setup_t.O.doc; - test = mk_section_args_fun setup_t.O.test; - install = mk_std_args_fun setup_t.O.install; - uninstall = mk_std_args_fun setup_t.O.uninstall; - clean = List.map mk_std_args_fun setup_t.O.clean; - clean_doc = mk_section_args_fun setup_t.O.clean_doc; - clean_test = mk_section_args_fun setup_t.O.clean_test; - distclean = List.map mk_std_args_fun setup_t.O.distclean; - distclean_doc = mk_section_args_fun setup_t.O.distclean_doc; - distclean_test = mk_section_args_fun setup_t.O.distclean_test; - - package = setup_t.O.package; - oasis_fn = setup_t.O.oasis_fn; - oasis_version = setup_t.O.oasis_version; - oasis_digest = setup_t.O.oasis_digest; - oasis_exec = setup_t.O.oasis_exec; - oasis_setup_args = setup_t.O.oasis_setup_args; - setup_update = setup_t.O.setup_update; - } - end - - - module Compat_0_3 = - struct - include Compat_0_4 - end - -end - - -# 5662 "setup.ml" -module InternalConfigurePlugin = struct -(* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *) - - - (** Configure using internal scheme - @author Sylvain Le Gall - *) - - - open BaseEnv - open OASISTypes - open OASISUtils - open OASISGettext - open BaseMessage - - - (** Configure build using provided series of check to be done - and then output corresponding file. - *) - let configure ~ctxt:_ pkg argv = - let var_ignore_eval var = let _s: string = var () in () in - let errors = ref SetString.empty in - let buff = Buffer.create 13 in - - let add_errors fmt = - Printf.kbprintf - (fun b -> - errors := SetString.add (Buffer.contents b) !errors; - Buffer.clear b) - buff - fmt - in - - let warn_exception e = - warning "%s" (Printexc.to_string e) - in - - (* Check tools *) - let check_tools lst = - List.iter - (function - | ExternalTool tool -> - begin - try - var_ignore_eval (BaseCheck.prog tool) - with e -> - warn_exception e; - add_errors (f_ "Cannot find external tool '%s'") tool - end - | InternalExecutable nm1 -> - (* Check that matching tool is built *) - List.iter - (function - | Executable ({cs_name = nm2; _}, - {bs_build = build; _}, - _) when nm1 = nm2 -> - if not (var_choose build) then - add_errors - (f_ "Cannot find buildable internal executable \ - '%s' when checking build depends") - nm1 - | _ -> - ()) - pkg.sections) - lst - in - - let build_checks sct bs = - if var_choose bs.bs_build then - begin - if bs.bs_compiled_object = Native then - begin - try - var_ignore_eval BaseStandardVar.ocamlopt - with e -> - warn_exception e; - add_errors - (f_ "Section %s requires native compilation") - (OASISSection.string_of_section sct) - end; - - (* Check tools *) - check_tools bs.bs_build_tools; - - (* Check depends *) - List.iter - (function - | FindlibPackage (findlib_pkg, version_comparator) -> - begin - try - var_ignore_eval - (BaseCheck.package ?version_comparator findlib_pkg) - with e -> - warn_exception e; - match version_comparator with - | None -> - add_errors - (f_ "Cannot find findlib package %s") - findlib_pkg - | Some ver_cmp -> - add_errors - (f_ "Cannot find findlib package %s (%s)") - findlib_pkg - (OASISVersion.string_of_comparator ver_cmp) - end - | InternalLibrary nm1 -> - (* Check that matching library is built *) - List.iter - (function - | Library ({cs_name = nm2; _}, - {bs_build = build; _}, - _) when nm1 = nm2 -> - if not (var_choose build) then - add_errors - (f_ "Cannot find buildable internal library \ - '%s' when checking build depends") - nm1 - | _ -> - ()) - pkg.sections) - bs.bs_build_depends - end - in - - (* Parse command line *) - BaseArgExt.parse argv (BaseEnv.args ()); - - (* OCaml version *) - begin - match pkg.ocaml_version with - | Some ver_cmp -> - begin - try - var_ignore_eval - (BaseCheck.version - "ocaml" - ver_cmp - BaseStandardVar.ocaml_version) - with e -> - warn_exception e; - add_errors - (f_ "OCaml version %s doesn't match version constraint %s") - (BaseStandardVar.ocaml_version ()) - (OASISVersion.string_of_comparator ver_cmp) - end - | None -> - () - end; - - (* Findlib version *) - begin - match pkg.findlib_version with - | Some ver_cmp -> - begin - try - var_ignore_eval - (BaseCheck.version - "findlib" - ver_cmp - BaseStandardVar.findlib_version) - with e -> - warn_exception e; - add_errors - (f_ "Findlib version %s doesn't match version constraint %s") - (BaseStandardVar.findlib_version ()) - (OASISVersion.string_of_comparator ver_cmp) - end - | None -> - () - end; - (* Make sure the findlib version is fine for the OCaml compiler. *) - begin - let ocaml_ge4 = - OASISVersion.version_compare - (OASISVersion.version_of_string (BaseStandardVar.ocaml_version ())) - (OASISVersion.version_of_string "4.0.0") >= 0 in - if ocaml_ge4 then - let findlib_lt132 = - OASISVersion.version_compare - (OASISVersion.version_of_string (BaseStandardVar.findlib_version())) - (OASISVersion.version_of_string "1.3.2") < 0 in - if findlib_lt132 then - add_errors "OCaml >= 4.0.0 requires Findlib version >= 1.3.2" - end; - - (* FlexDLL *) - if BaseStandardVar.os_type () = "Win32" || - BaseStandardVar.os_type () = "Cygwin" then - begin - try - var_ignore_eval BaseStandardVar.flexlink - with e -> - warn_exception e; - add_errors (f_ "Cannot find 'flexlink'") - end; - - (* Check build depends *) - List.iter - (function - | Executable (_, bs, _) - | Library (_, bs, _) as sct -> - build_checks sct bs - | Doc (_, doc) -> - if var_choose doc.doc_build then - check_tools doc.doc_build_tools - | Test (_, test) -> - if var_choose test.test_run then - check_tools test.test_tools - | _ -> - ()) - pkg.sections; - - (* Check if we need native dynlink (presence of libraries that compile to - native) - *) - begin - let has_cmxa = - List.exists - (function - | Library (_, bs, _) -> - var_choose bs.bs_build && - (bs.bs_compiled_object = Native || - (bs.bs_compiled_object = Best && - bool_of_string (BaseStandardVar.is_native ()))) - | _ -> - false) - pkg.sections - in - if has_cmxa then - var_ignore_eval BaseStandardVar.native_dynlink - end; - - (* Check errors *) - if SetString.empty != !errors then - begin - List.iter - (fun e -> error "%s" e) - (SetString.elements !errors); - failwithf - (fn_ - "%d configuration error" - "%d configuration errors" - (SetString.cardinal !errors)) - (SetString.cardinal !errors) - end - - -end - -module InternalInstallPlugin = struct -(* # 22 "src/plugins/internal/InternalInstallPlugin.ml" *) - - - (** Install using internal scheme - @author Sylvain Le Gall - *) - - - (* TODO: rewrite this module with OASISFileSystem. *) - - open BaseEnv - open BaseStandardVar - open BaseMessage - open OASISTypes - open OASISFindlib - open OASISGettext - open OASISUtils - - - let exec_hook = ref (fun (cs, bs, exec) -> cs, bs, exec) - let lib_hook = ref (fun (cs, bs, dn, lib) -> cs, bs, dn, lib, []) - let obj_hook = ref (fun (cs, bs, dn, obj) -> cs, bs, dn, obj, []) - let doc_hook = ref (fun (cs, doc) -> cs, doc) - - let install_file_ev = "install-file" - let install_dir_ev = "install-dir" - let install_findlib_ev = "install-findlib" - - - (* TODO: this can be more generic and used elsewhere. *) - let win32_max_command_line_length = 8000 - - - let split_install_command ocamlfind findlib_name meta files = - if Sys.os_type = "Win32" then - (* Arguments for the first command: *) - let first_args = ["install"; findlib_name; meta] in - (* Arguments for remaining commands: *) - let other_args = ["install"; findlib_name; "-add"] in - (* Extract as much files as possible from [files], [len] is - the current command line length: *) - let rec get_files len acc files = - match files with - | [] -> - (List.rev acc, []) - | file :: rest -> - let len = len + 1 + String.length file in - if len > win32_max_command_line_length then - (List.rev acc, files) - else - get_files len (file :: acc) rest - in - (* Split the command into several commands. *) - let rec split args files = - match files with - | [] -> - [] - | _ -> - (* Length of "ocamlfind install [META|-add]" *) - let len = - List.fold_left - (fun len arg -> - len + 1 (* for the space *) + String.length arg) - (String.length ocamlfind) - args - in - match get_files len [] files with - | ([], _) -> - failwith (s_ "Command line too long.") - | (firsts, others) -> - let cmd = args @ firsts in - (* Use -add for remaining commands: *) - let () = - let findlib_ge_132 = - OASISVersion.comparator_apply - (OASISVersion.version_of_string - (BaseStandardVar.findlib_version ())) - (OASISVersion.VGreaterEqual - (OASISVersion.version_of_string "1.3.2")) - in - if not findlib_ge_132 then - failwithf - (f_ "Installing the library %s require to use the \ - flag '-add' of ocamlfind because the command \ - line is too long. This flag is only available \ - for findlib 1.3.2. Please upgrade findlib from \ - %s to 1.3.2") - findlib_name (BaseStandardVar.findlib_version ()) - in - let cmds = split other_args others in - cmd :: cmds - in - (* The first command does not use -add: *) - split first_args files - else - ["install" :: findlib_name :: meta :: files] - - - let install = - - let in_destdir fn = - try - (* Practically speaking destdir is prepended at the beginning of the - target filename - *) - (destdir ())^fn - with PropList.Not_set _ -> - fn - in - - let install_file ~ctxt ?(prepend_destdir=true) ?tgt_fn src_file envdir = - let tgt_dir = - if prepend_destdir then in_destdir (envdir ()) else envdir () - in - let tgt_file = - Filename.concat - tgt_dir - (match tgt_fn with - | Some fn -> - fn - | None -> - Filename.basename src_file) - in - (* Create target directory if needed *) - OASISFileUtil.mkdir_parent - ~ctxt - (fun dn -> - info (f_ "Creating directory '%s'") dn; - BaseLog.register ~ctxt install_dir_ev dn) - (Filename.dirname tgt_file); - - (* Really install files *) - info (f_ "Copying file '%s' to '%s'") src_file tgt_file; - OASISFileUtil.cp ~ctxt src_file tgt_file; - BaseLog.register ~ctxt install_file_ev tgt_file - in - - (* Install the files for a library. *) - - let install_lib_files ~ctxt findlib_name files = - let findlib_dir = - let dn = - let findlib_destdir = - OASISExec.run_read_one_line ~ctxt (ocamlfind ()) - ["printconf" ; "destdir"] - in - Filename.concat findlib_destdir findlib_name - in - fun () -> dn - in - let () = - if not (OASISFileUtil.file_exists_case (findlib_dir ())) then - failwithf - (f_ "Directory '%s' doesn't exist for findlib library %s") - (findlib_dir ()) findlib_name - in - let f dir file = - let basename = Filename.basename file in - let tgt_fn = Filename.concat dir basename in - (* Destdir is already include in printconf. *) - install_file ~ctxt ~prepend_destdir:false ~tgt_fn file findlib_dir - in - List.iter (fun (dir, files) -> List.iter (f dir) files) files ; - in - - (* Install data into defined directory *) - let install_data ~ctxt srcdir lst tgtdir = - let tgtdir = - OASISHostPath.of_unix (var_expand tgtdir) - in - List.iter - (fun (src, tgt_opt) -> - let real_srcs = - OASISFileUtil.glob - ~ctxt:!BaseContext.default - (Filename.concat srcdir src) - in - if real_srcs = [] then - failwithf - (f_ "Wildcard '%s' doesn't match any files") - src; - List.iter - (fun fn -> - install_file ~ctxt - fn - (fun () -> - match tgt_opt with - | Some s -> - OASISHostPath.of_unix (var_expand s) - | None -> - tgtdir)) - real_srcs) - lst - in - - let make_fnames modul sufx = - List.fold_right - begin fun sufx accu -> - (OASISString.capitalize_ascii modul ^ sufx) :: - (OASISString.uncapitalize_ascii modul ^ sufx) :: - accu - end - sufx - [] - in - - (** Install all libraries *) - let install_libs ~ctxt pkg = - - let find_first_existing_files_in_path bs lst = - let path = OASISHostPath.of_unix bs.bs_path in - List.find - OASISFileUtil.file_exists_case - (List.map (Filename.concat path) lst) - in - - let files_of_modules new_files typ cs bs modules = - List.fold_left - (fun acc modul -> - begin - try - (* Add uncompiled header from the source tree *) - [find_first_existing_files_in_path - bs (make_fnames modul [".mli"; ".ml"])] - with Not_found -> - warning - (f_ "Cannot find source header for module %s \ - in %s %s") - typ modul cs.cs_name; - [] - end - @ - List.fold_left - (fun acc fn -> - try - find_first_existing_files_in_path bs [fn] :: acc - with Not_found -> - acc) - acc (make_fnames modul [".annot";".cmti";".cmt"])) - new_files - modules - in - - let files_of_build_section (f_data, new_files) typ cs bs = - let extra_files = - List.map - (fun fn -> - try - find_first_existing_files_in_path bs [fn] - with Not_found -> - failwithf - (f_ "Cannot find extra findlib file %S in %s %s ") - fn - typ - cs.cs_name) - bs.bs_findlib_extra_files - in - let f_data () = - (* Install data associated with the library *) - install_data - ~ctxt - bs.bs_path - bs.bs_data_files - (Filename.concat - (datarootdir ()) - pkg.name); - f_data () - in - f_data, new_files @ extra_files - in - - let files_of_library (f_data, acc) data_lib = - let cs, bs, lib, dn, lib_extra = !lib_hook data_lib in - if var_choose bs.bs_install && - BaseBuilt.is_built ~ctxt BaseBuilt.BLib cs.cs_name then begin - (* Start with lib_extra *) - let new_files = lib_extra in - let new_files = - files_of_modules new_files "library" cs bs lib.lib_modules - in - let f_data, new_files = - files_of_build_section (f_data, new_files) "library" cs bs - in - let new_files = - (* Get generated files *) - BaseBuilt.fold - ~ctxt - BaseBuilt.BLib - cs.cs_name - (fun acc fn -> fn :: acc) - new_files - in - let acc = (dn, new_files) :: acc in - - let f_data () = - (* Install data associated with the library *) - install_data - ~ctxt - bs.bs_path - bs.bs_data_files - (Filename.concat - (datarootdir ()) - pkg.name); - f_data () - in - - (f_data, acc) - end else begin - (f_data, acc) - end - and files_of_object (f_data, acc) data_obj = - let cs, bs, obj, dn, obj_extra = !obj_hook data_obj in - if var_choose bs.bs_install && - BaseBuilt.is_built ~ctxt BaseBuilt.BObj cs.cs_name then begin - (* Start with obj_extra *) - let new_files = obj_extra in - let new_files = - files_of_modules new_files "object" cs bs obj.obj_modules - in - let f_data, new_files = - files_of_build_section (f_data, new_files) "object" cs bs - in - - let new_files = - (* Get generated files *) - BaseBuilt.fold - ~ctxt - BaseBuilt.BObj - cs.cs_name - (fun acc fn -> fn :: acc) - new_files - in - let acc = (dn, new_files) :: acc in - - let f_data () = - (* Install data associated with the object *) - install_data - ~ctxt - bs.bs_path - bs.bs_data_files - (Filename.concat (datarootdir ()) pkg.name); - f_data () - in - (f_data, acc) - end else begin - (f_data, acc) - end - in - - (* Install one group of library *) - let install_group_lib grp = - (* Iterate through all group nodes *) - let rec install_group_lib_aux data_and_files grp = - let data_and_files, children = - match grp with - | Container (_, children) -> - data_and_files, children - | Package (_, cs, bs, `Library lib, dn, children) -> - files_of_library data_and_files (cs, bs, lib, dn), children - | Package (_, cs, bs, `Object obj, dn, children) -> - files_of_object data_and_files (cs, bs, obj, dn), children - in - List.fold_left - install_group_lib_aux - data_and_files - children - in - - (* Findlib name of the root library *) - let findlib_name = findlib_of_group grp in - - (* Determine root library *) - let root_lib = root_of_group grp in - - (* All files to install for this library *) - let f_data, files = install_group_lib_aux (ignore, []) grp in - - (* Really install, if there is something to install *) - if files = [] then begin - warning - (f_ "Nothing to install for findlib library '%s'") findlib_name - end else begin - let meta = - (* Search META file *) - let _, bs, _ = root_lib in - let res = Filename.concat bs.bs_path "META" in - if not (OASISFileUtil.file_exists_case res) then - failwithf - (f_ "Cannot find file '%s' for findlib library %s") - res - findlib_name; - res - in - let files = - (* Make filename shorter to avoid hitting command max line length - * too early, esp. on Windows. - *) - (* TODO: move to OASISHostPath as make_relative. *) - let remove_prefix p n = - let plen = String.length p in - let nlen = String.length n in - if plen <= nlen && String.sub n 0 plen = p then begin - let fn_sep = if Sys.os_type = "Win32" then '\\' else '/' in - let cutpoint = - plen + - (if plen < nlen && n.[plen] = fn_sep then 1 else 0) - in - String.sub n cutpoint (nlen - cutpoint) - end else begin - n - end - in - List.map - (fun (dir, fn) -> - (dir, List.map (remove_prefix (Sys.getcwd ())) fn)) - files - in - let ocamlfind = ocamlfind () in - let nodir_files, dir_files = - List.fold_left - (fun (nodir, dir) (dn, lst) -> - match dn with - | Some dn -> nodir, (dn, lst) :: dir - | None -> lst @ nodir, dir) - ([], []) - (List.rev files) - in - info (f_ "Installing findlib library '%s'") findlib_name; - List.iter - (OASISExec.run ~ctxt ocamlfind) - (split_install_command ocamlfind findlib_name meta nodir_files); - install_lib_files ~ctxt findlib_name dir_files; - BaseLog.register ~ctxt install_findlib_ev findlib_name - end; - - (* Install data files *) - f_data (); - in - - let group_libs, _, _ = findlib_mapping pkg in - - (* We install libraries in groups *) - List.iter install_group_lib group_libs - in - - let install_execs ~ctxt pkg = - let install_exec data_exec = - let cs, bs, _ = !exec_hook data_exec in - if var_choose bs.bs_install && - BaseBuilt.is_built ~ctxt BaseBuilt.BExec cs.cs_name then begin - let exec_libdir () = Filename.concat (libdir ()) pkg.name in - BaseBuilt.fold - ~ctxt - BaseBuilt.BExec - cs.cs_name - (fun () fn -> - install_file ~ctxt - ~tgt_fn:(cs.cs_name ^ ext_program ()) - fn - bindir) - (); - BaseBuilt.fold - ~ctxt - BaseBuilt.BExecLib - cs.cs_name - (fun () fn -> install_file ~ctxt fn exec_libdir) - (); - install_data ~ctxt - bs.bs_path - bs.bs_data_files - (Filename.concat (datarootdir ()) pkg.name) - end - in - List.iter - (function - | Executable (cs, bs, exec)-> install_exec (cs, bs, exec) - | _ -> ()) - pkg.sections - in - - let install_docs ~ctxt pkg = - let install_doc data = - let cs, doc = !doc_hook data in - if var_choose doc.doc_install && - BaseBuilt.is_built ~ctxt BaseBuilt.BDoc cs.cs_name then begin - let tgt_dir = OASISHostPath.of_unix (var_expand doc.doc_install_dir) in - BaseBuilt.fold - ~ctxt - BaseBuilt.BDoc - cs.cs_name - (fun () fn -> install_file ~ctxt fn (fun () -> tgt_dir)) - (); - install_data ~ctxt - Filename.current_dir_name - doc.doc_data_files - doc.doc_install_dir - end - in - List.iter - (function - | Doc (cs, doc) -> install_doc (cs, doc) - | _ -> ()) - pkg.sections - in - fun ~ctxt pkg _ -> - install_libs ~ctxt pkg; - install_execs ~ctxt pkg; - install_docs ~ctxt pkg - - - (* Uninstall already installed data *) - let uninstall ~ctxt _ _ = - let uninstall_aux (ev, data) = - if ev = install_file_ev then begin - if OASISFileUtil.file_exists_case data then begin - info (f_ "Removing file '%s'") data; - Sys.remove data - end else begin - warning (f_ "File '%s' doesn't exist anymore") data - end - end else if ev = install_dir_ev then begin - if Sys.file_exists data && Sys.is_directory data then begin - if Sys.readdir data = [||] then begin - info (f_ "Removing directory '%s'") data; - OASISFileUtil.rmdir ~ctxt data - end else begin - warning - (f_ "Directory '%s' is not empty (%s)") - data - (String.concat ", " (Array.to_list (Sys.readdir data))) - end - end else begin - warning (f_ "Directory '%s' doesn't exist anymore") data - end - end else if ev = install_findlib_ev then begin - info (f_ "Removing findlib library '%s'") data; - OASISExec.run ~ctxt (ocamlfind ()) ["remove"; data] - end else begin - failwithf (f_ "Unknown log event '%s'") ev; - end; - BaseLog.unregister ~ctxt ev data - in - (* We process event in reverse order *) - List.iter uninstall_aux - (List.rev - (BaseLog.filter ~ctxt [install_file_ev; install_dir_ev])); - List.iter uninstall_aux - (List.rev (BaseLog.filter ~ctxt [install_findlib_ev])) - -end - - -# 6465 "setup.ml" -module OCamlbuildCommon = struct -(* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *) - - - (** Functions common to OCamlbuild build and doc plugin - *) - - - open OASISGettext - open BaseEnv - open BaseStandardVar - open OASISTypes - - - type extra_args = string list - - - let ocamlbuild_clean_ev = "ocamlbuild-clean" - - - let ocamlbuildflags = - var_define - ~short_desc:(fun () -> "OCamlbuild additional flags") - "ocamlbuildflags" - (fun () -> "") - - - (** Fix special arguments depending on environment *) - let fix_args args extra_argv = - List.flatten - [ - if (os_type ()) = "Win32" then - [ - "-classic-display"; - "-no-log"; - "-no-links"; - ] - else - []; - - if OASISVersion.comparator_apply - (OASISVersion.version_of_string (ocaml_version ())) - (OASISVersion.VLesser (OASISVersion.version_of_string "3.11.1")) then - [ - "-install-lib-dir"; - (Filename.concat (standard_library ()) "ocamlbuild") - ] - else - []; - - if not (bool_of_string (is_native ())) || (os_type ()) = "Win32" then - [ - "-byte-plugin" - ] - else - []; - args; - - if bool_of_string (debug ()) then - ["-tag"; "debug"] - else - []; - - if bool_of_string (tests ()) then - ["-tag"; "tests"] - else - []; - - if bool_of_string (profile ()) then - ["-tag"; "profile"] - else - []; - - OASISString.nsplit (ocamlbuildflags ()) ' '; - - Array.to_list extra_argv; - ] - - - (** Run 'ocamlbuild -clean' if not already done *) - let run_clean ~ctxt extra_argv = - let extra_cli = - String.concat " " (Array.to_list extra_argv) - in - (* Run if never called with these args *) - if not (BaseLog.exists ~ctxt ocamlbuild_clean_ev extra_cli) then - begin - OASISExec.run ~ctxt (ocamlbuild ()) (fix_args ["-clean"] extra_argv); - BaseLog.register ~ctxt ocamlbuild_clean_ev extra_cli; - at_exit - (fun () -> - try - BaseLog.unregister ~ctxt ocamlbuild_clean_ev extra_cli - with _ -> ()) - end - - - (** Run ocamlbuild, unregister all clean events *) - let run_ocamlbuild ~ctxt args extra_argv = - (* TODO: enforce that target in args must be UNIX encoded i.e. toto/index.html - *) - OASISExec.run ~ctxt (ocamlbuild ()) (fix_args args extra_argv); - (* Remove any clean event, we must run it again *) - List.iter - (fun (e, d) -> BaseLog.unregister ~ctxt e d) - (BaseLog.filter ~ctxt [ocamlbuild_clean_ev]) - - - (** Determine real build directory *) - let build_dir extra_argv = - let rec search_args dir = - function - | "-build-dir" :: dir :: tl -> - search_args dir tl - | _ :: tl -> - search_args dir tl - | [] -> - dir - in - search_args "_build" (fix_args [] extra_argv) - - -end - -module OCamlbuildPlugin = struct -(* # 22 "src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *) - - - (** Build using ocamlbuild - @author Sylvain Le Gall - *) - - - open OASISTypes - open OASISGettext - open OASISUtils - open OASISString - open BaseEnv - open OCamlbuildCommon - open BaseStandardVar - - - let cond_targets_hook = ref (fun lst -> lst) - - - let build ~ctxt extra_args pkg argv = - (* Return the filename in build directory *) - let in_build_dir fn = - Filename.concat - (build_dir argv) - fn - in - - (* Return the unix filename in host build directory *) - let in_build_dir_of_unix fn = - in_build_dir (OASISHostPath.of_unix fn) - in - - let cond_targets = - List.fold_left - (fun acc -> - function - | Library (cs, bs, lib) when var_choose bs.bs_build -> - begin - let evs, unix_files = - BaseBuilt.of_library - in_build_dir_of_unix - (cs, bs, lib) - in - - let tgts = - List.flatten - (List.filter - (fun l -> l <> []) - (List.map - (List.filter - (fun fn -> - ends_with ~what:".cma" fn - || ends_with ~what:".cmxs" fn - || ends_with ~what:".cmxa" fn - || ends_with ~what:(ext_lib ()) fn - || ends_with ~what:(ext_dll ()) fn)) - unix_files)) - in - - match tgts with - | _ :: _ -> - (evs, tgts) :: acc - | [] -> - failwithf - (f_ "No possible ocamlbuild targets for library %s") - cs.cs_name - end - - | Object (cs, bs, obj) when var_choose bs.bs_build -> - begin - let evs, unix_files = - BaseBuilt.of_object - in_build_dir_of_unix - (cs, bs, obj) - in - - let tgts = - List.flatten - (List.filter - (fun l -> l <> []) - (List.map - (List.filter - (fun fn -> - ends_with ~what:".cmo" fn - || ends_with ~what:".cmx" fn)) - unix_files)) - in - - match tgts with - | _ :: _ -> - (evs, tgts) :: acc - | [] -> - failwithf - (f_ "No possible ocamlbuild targets for object %s") - cs.cs_name - end - - | Executable (cs, bs, exec) when var_choose bs.bs_build -> - begin - let evs, _, _ = - BaseBuilt.of_executable in_build_dir_of_unix (cs, bs, exec) - in - - let target ext = - let unix_tgt = - (OASISUnixPath.concat - bs.bs_path - (OASISUnixPath.chop_extension - exec.exec_main_is))^ext - in - let evs = - (* Fix evs, we want to use the unix_tgt, without copying *) - List.map - (function - | BaseBuilt.BExec, nm, _ when nm = cs.cs_name -> - BaseBuilt.BExec, nm, - [[in_build_dir_of_unix unix_tgt]] - | ev -> - ev) - evs - in - evs, [unix_tgt] - in - - (* Add executable *) - let acc = - match bs.bs_compiled_object with - | Native -> - (target ".native") :: acc - | Best when bool_of_string (is_native ()) -> - (target ".native") :: acc - | Byte - | Best -> - (target ".byte") :: acc - in - acc - end - - | Library _ | Object _ | Executable _ | Test _ - | SrcRepo _ | Flag _ | Doc _ -> - acc) - [] - (* Keep the pkg.sections ordered *) - (List.rev pkg.sections); - in - - (* Check and register built files *) - let check_and_register (bt, bnm, lst) = - List.iter - (fun fns -> - if not (List.exists OASISFileUtil.file_exists_case fns) then - failwithf - (fn_ - "Expected built file %s doesn't exist." - "None of expected built files %s exists." - (List.length fns)) - (String.concat (s_ " or ") (List.map (Printf.sprintf "'%s'") fns))) - lst; - (BaseBuilt.register ~ctxt bt bnm lst) - in - - (* Run the hook *) - let cond_targets = !cond_targets_hook cond_targets in - - (* Run a list of target... *) - run_ocamlbuild - ~ctxt - (List.flatten (List.map snd cond_targets) @ extra_args) - argv; - (* ... and register events *) - List.iter check_and_register (List.flatten (List.map fst cond_targets)) - - - let clean ~ctxt pkg extra_args = - run_clean ~ctxt extra_args; - List.iter - (function - | Library (cs, _, _) -> - BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name - | Executable (cs, _, _) -> - BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name; - BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name - | _ -> - ()) - pkg.sections - - -end - -module OCamlbuildDocPlugin = struct -(* # 22 "src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" *) - - - (* Create documentation using ocamlbuild .odocl files - @author Sylvain Le Gall - *) - - - open OASISTypes - open OASISGettext - open OCamlbuildCommon - - - type run_t = - { - extra_args: string list; - run_path: unix_filename; - } - - - let doc_build ~ctxt run _ (cs, _) argv = - let index_html = - OASISUnixPath.make - [ - run.run_path; - cs.cs_name^".docdir"; - "index.html"; - ] - in - let tgt_dir = - OASISHostPath.make - [ - build_dir argv; - OASISHostPath.of_unix run.run_path; - cs.cs_name^".docdir"; - ] - in - run_ocamlbuild ~ctxt (index_html :: run.extra_args) argv; - List.iter - (fun glb -> - match OASISFileUtil.glob ~ctxt (Filename.concat tgt_dir glb) with - | (_ :: _) as filenames -> - BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name [filenames] - | [] -> ()) - ["*.html"; "*.css"] - - - let doc_clean ~ctxt _ _ (cs, _) argv = - run_clean ~ctxt argv; - BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name - - -end - - -# 6837 "setup.ml" -module CustomPlugin = struct -(* # 22 "src/plugins/custom/CustomPlugin.ml" *) - - - (** Generate custom configure/build/doc/test/install system - @author - *) - - - open BaseEnv - open OASISGettext - open OASISTypes - - type t = - { - cmd_main: command_line conditional; - cmd_clean: (command_line option) conditional; - cmd_distclean: (command_line option) conditional; - } - - - let run = BaseCustom.run - - - let main ~ctxt:_ t _ extra_args = - let cmd, args = var_choose ~name:(s_ "main command") t.cmd_main in - run cmd args extra_args - - - let clean ~ctxt:_ t _ extra_args = - match var_choose t.cmd_clean with - | Some (cmd, args) -> run cmd args extra_args - | _ -> () - - - let distclean ~ctxt:_ t _ extra_args = - match var_choose t.cmd_distclean with - | Some (cmd, args) -> run cmd args extra_args - | _ -> () - - - module Build = - struct - let main ~ctxt t pkg extra_args = - main ~ctxt t pkg extra_args; - List.iter - (fun sct -> - let evs = - match sct with - | Library (cs, bs, lib) when var_choose bs.bs_build -> - begin - let evs, _ = - BaseBuilt.of_library - OASISHostPath.of_unix - (cs, bs, lib) - in - evs - end - | Executable (cs, bs, exec) when var_choose bs.bs_build -> - begin - let evs, _, _ = - BaseBuilt.of_executable - OASISHostPath.of_unix - (cs, bs, exec) - in - evs - end - | _ -> - [] - in - List.iter - (fun (bt, bnm, lst) -> BaseBuilt.register ~ctxt bt bnm lst) - evs) - pkg.sections - - let clean ~ctxt t pkg extra_args = - clean ~ctxt t pkg extra_args; - (* TODO: this seems to be pretty generic (at least wrt to ocamlbuild - * considering moving this to BaseSetup? - *) - List.iter - (function - | Library (cs, _, _) -> - BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name - | Executable (cs, _, _) -> - BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name; - BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name - | _ -> - ()) - pkg.sections - - let distclean ~ctxt t pkg extra_args = distclean ~ctxt t pkg extra_args - end - - - module Test = - struct - let main ~ctxt t pkg (cs, _) extra_args = - try - main ~ctxt t pkg extra_args; - 0.0 - with Failure s -> - BaseMessage.warning - (f_ "Test '%s' fails: %s") - cs.cs_name - s; - 1.0 - - let clean ~ctxt t pkg _ extra_args = clean ~ctxt t pkg extra_args - - let distclean ~ctxt t pkg _ extra_args = distclean ~ctxt t pkg extra_args - end - - - module Doc = - struct - let main ~ctxt t pkg (cs, _) extra_args = - main ~ctxt t pkg extra_args; - BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name [] - - let clean ~ctxt t pkg (cs, _) extra_args = - clean ~ctxt t pkg extra_args; - BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name - - let distclean ~ctxt t pkg _ extra_args = distclean ~ctxt t pkg extra_args - end - - -end - - -# 6969 "setup.ml" -open OASISTypes;; - -let setup_t = - { - BaseSetup.configure = InternalConfigurePlugin.configure; - build = OCamlbuildPlugin.build []; - test = - [ - ("lib_test", - CustomPlugin.Test.main - { - CustomPlugin.cmd_main = - [ - (OASISExpr.EBool true, - ("./test.native", ["-runner"; "sequential"])) - ]; - cmd_clean = [(OASISExpr.EBool true, None)]; - cmd_distclean = [(OASISExpr.EBool true, None)] - }) - ]; - doc = []; - install = InternalInstallPlugin.install; - uninstall = InternalInstallPlugin.uninstall; - clean = [OCamlbuildPlugin.clean]; - clean_test = - [ - ("lib_test", - CustomPlugin.Test.clean - { - CustomPlugin.cmd_main = - [ - (OASISExpr.EBool true, - ("./test.native", ["-runner"; "sequential"])) - ]; - cmd_clean = [(OASISExpr.EBool true, None)]; - cmd_distclean = [(OASISExpr.EBool true, None)] - }) - ]; - clean_doc = []; - distclean = []; - distclean_test = - [ - ("lib_test", - CustomPlugin.Test.distclean - { - CustomPlugin.cmd_main = - [ - (OASISExpr.EBool true, - ("./test.native", ["-runner"; "sequential"])) - ]; - cmd_clean = [(OASISExpr.EBool true, None)]; - cmd_distclean = [(OASISExpr.EBool true, None)] - }) - ]; - distclean_doc = []; - package = - { - oasis_version = "0.4"; - ocaml_version = None; - version = "1.2.0"; - license = - OASISLicense.DEP5License - (OASISLicense.DEP5Unit - { - OASISLicense.license = "LGPL"; - excption = Some "OCaml linking"; - version = OASISLicense.Version "2.1" - }); - findlib_version = None; - alpha_features = []; - beta_features = []; - name = "xcp-idl"; - license_file = None; - copyrights = []; - maintainers = []; - authors = ["David Scott"]; - homepage = None; - bugreports = None; - synopsis = - "Interface definitions and common boilerplate for the xapi toolstack"; - description = None; - tags = []; - categories = []; - files_ab = []; - sections = - [ - Library - ({ - cs_name = "xcp"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = [(OASISExpr.EBool true, true)]; - bs_install = [(OASISExpr.EBool true, true)]; - bs_path = "lib"; - bs_compiled_object = Best; - bs_build_depends = - [ - FindlibPackage ("cmdliner", None); - FindlibPackage ("uri", None); - FindlibPackage ("re", None); - FindlibPackage ("cohttp", None); - FindlibPackage ("xmlm", None); - FindlibPackage ("unix", None); - FindlibPackage ("ppx_sexp_conv", None); - FindlibPackage ("sexplib", None); - FindlibPackage ("ppx_deriving_rpc", None); - FindlibPackage ("rpclib", None); - FindlibPackage ("rpclib.xml", None); - FindlibPackage ("threads", None); - FindlibPackage - ("message_switch", - Some (OASISVersion.VGreaterEqual "0.11.0")); - FindlibPackage ("message_switch.unix", None); - FindlibPackage ("fd-send-recv", None); - FindlibPackage ("xcp-inventory", None); - FindlibPackage ("xapi-backtrace", None) - ]; - bs_build_tools = [ExternalTool "ocamlbuild"]; - bs_interface_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${capitalize_file module}.mli" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${uncapitalize_file module}.mli" - } - ]; - bs_implementation_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${capitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${uncapitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${capitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${uncapitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${capitalize_file module}.mly" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${uncapitalize_file module}.mly" - } - ]; - bs_c_sources = ["syslog_stubs.c"]; - bs_data_files = []; - bs_findlib_extra_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 = - [ - "Cohttp_posix_io"; - "Posix_channel"; - "Open_uri"; - "Xcp_client"; - "Xcp_service"; - "Xcp_channel"; - "Xcp_channel_protocol"; - "Syslog"; - "Debug" - ]; - lib_pack = false; - lib_internal_modules = []; - lib_findlib_parent = None; - lib_findlib_name = Some "xcp"; - lib_findlib_directory = None; - lib_findlib_containers = [] - }); - Library - ({ - cs_name = "xcp_updates"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = [(OASISExpr.EBool true, true)]; - bs_install = [(OASISExpr.EBool true, true)]; - bs_path = "lib"; - bs_compiled_object = Best; - bs_build_depends = []; - bs_build_tools = [ExternalTool "ocamlbuild"]; - bs_interface_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${capitalize_file module}.mli" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${uncapitalize_file module}.mli" - } - ]; - bs_implementation_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${capitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${uncapitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${capitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${uncapitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${capitalize_file module}.mly" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${uncapitalize_file module}.mly" - } - ]; - bs_c_sources = []; - bs_data_files = []; - bs_findlib_extra_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 = ["Updates"; "Task_server"; "Scheduler"]; - lib_pack = false; - lib_internal_modules = []; - lib_findlib_parent = Some "xcp"; - lib_findlib_name = Some "updates"; - lib_findlib_directory = None; - lib_findlib_containers = [] - }); - Library - ({ - cs_name = "xcp_storage"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = [(OASISExpr.EBool true, true)]; - bs_install = [(OASISExpr.EBool true, true)]; - bs_path = "storage"; - bs_compiled_object = Best; - bs_build_depends = - [ - InternalLibrary "xcp"; - FindlibPackage ("threads", None); - FindlibPackage ("rpclib", None) - ]; - bs_build_tools = [ExternalTool "ocamlbuild"]; - bs_interface_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${capitalize_file module}.mli" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${uncapitalize_file module}.mli" - } - ]; - bs_implementation_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${capitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${uncapitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${capitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${uncapitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${capitalize_file module}.mly" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${uncapitalize_file module}.mly" - } - ]; - bs_c_sources = []; - bs_data_files = []; - bs_findlib_extra_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 = - [ - "Storage_interface"; - "Vdi_automaton"; - "Storage_client"; - "Storage_skeleton"; - "Storage_skeleton_test" - ]; - lib_pack = false; - lib_internal_modules = []; - lib_findlib_parent = Some "xcp"; - lib_findlib_name = Some "storage"; - lib_findlib_directory = None; - lib_findlib_containers = [] - }); - Executable - ({ - cs_name = "storage_test"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = [(OASISExpr.EBool true, true)]; - bs_install = [(OASISExpr.EBool true, false)]; - bs_path = "storage"; - bs_compiled_object = Best; - bs_build_depends = - [ - InternalLibrary "xcp"; - InternalLibrary "xcp_storage"; - FindlibPackage ("oUnit", None); - FindlibPackage ("cmdliner", None) - ]; - bs_build_tools = [ExternalTool "ocamlbuild"]; - bs_interface_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${capitalize_file module}.mli" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${uncapitalize_file module}.mli" - } - ]; - bs_implementation_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${capitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${uncapitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${capitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${uncapitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${capitalize_file module}.mly" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${uncapitalize_file module}.mly" - } - ]; - bs_c_sources = []; - bs_data_files = []; - bs_findlib_extra_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, [])] - }, - {exec_custom = false; exec_main_is = "storage_test.ml"}); - Library - ({ - cs_name = "xcp_network"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = [(OASISExpr.EBool true, true)]; - bs_install = [(OASISExpr.EBool true, true)]; - bs_path = "network"; - bs_compiled_object = Best; - bs_build_depends = - [ - InternalLibrary "xcp"; - FindlibPackage ("threads", None); - FindlibPackage ("rpclib", None) - ]; - bs_build_tools = [ExternalTool "ocamlbuild"]; - bs_interface_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${capitalize_file module}.mli" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${uncapitalize_file module}.mli" - } - ]; - bs_implementation_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${capitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${uncapitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${capitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${uncapitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${capitalize_file module}.mly" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${uncapitalize_file module}.mly" - } - ]; - bs_c_sources = []; - bs_data_files = []; - bs_findlib_extra_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 = - [ - "Network_interface"; - "Network_client"; - "Network_stats" - ]; - lib_pack = false; - lib_internal_modules = []; - lib_findlib_parent = Some "xcp"; - lib_findlib_name = Some "network"; - lib_findlib_directory = None; - lib_findlib_containers = [] - }); - Library - ({ - cs_name = "xcp_rrd"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = [(OASISExpr.EBool true, true)]; - bs_install = [(OASISExpr.EBool true, true)]; - bs_path = "rrd"; - bs_compiled_object = Best; - bs_build_depends = - [ - InternalLibrary "xcp"; - FindlibPackage ("threads", None); - FindlibPackage ("rpclib", None); - FindlibPackage ("rrd", None) - ]; - bs_build_tools = [ExternalTool "ocamlbuild"]; - bs_interface_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${capitalize_file module}.mli" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${uncapitalize_file module}.mli" - } - ]; - bs_implementation_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${capitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${uncapitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${capitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${uncapitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${capitalize_file module}.mly" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${uncapitalize_file module}.mly" - } - ]; - bs_c_sources = []; - bs_data_files = []; - bs_findlib_extra_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 = - ["Data_source"; "Ds"; "Rrd_interface"; "Rrd_client"]; - lib_pack = false; - lib_internal_modules = []; - lib_findlib_parent = Some "xcp"; - lib_findlib_name = Some "rrd"; - lib_findlib_directory = None; - lib_findlib_containers = [] - }); - Library - ({ - cs_name = "xcp_xen"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = [(OASISExpr.EBool true, true)]; - bs_install = [(OASISExpr.EBool true, true)]; - bs_path = "xen"; - bs_compiled_object = Best; - bs_build_depends = - [ - InternalLibrary "xcp"; - FindlibPackage ("threads", None); - FindlibPackage ("ppx_deriving_rpc", None); - FindlibPackage ("rpclib", None) - ]; - bs_build_tools = [ExternalTool "ocamlbuild"]; - bs_interface_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${capitalize_file module}.mli" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${uncapitalize_file module}.mli" - } - ]; - bs_implementation_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${capitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${uncapitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${capitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${uncapitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${capitalize_file module}.mly" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${uncapitalize_file module}.mly" - } - ]; - bs_c_sources = []; - bs_data_files = []; - bs_findlib_extra_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 = - [ - "Xenops_interface"; - "Xenops_types"; - "Xenops_client"; - "Device_number" - ]; - lib_pack = false; - lib_internal_modules = []; - lib_findlib_parent = Some "xcp"; - lib_findlib_name = Some "xen"; - lib_findlib_directory = None; - lib_findlib_containers = [] - }); - Library - ({ - cs_name = "xcp_memory"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = [(OASISExpr.EBool true, true)]; - bs_install = [(OASISExpr.EBool true, true)]; - bs_path = "memory"; - bs_compiled_object = Best; - bs_build_depends = - [ - InternalLibrary "xcp"; - FindlibPackage ("threads", None); - FindlibPackage ("rpclib", None) - ]; - bs_build_tools = [ExternalTool "ocamlbuild"]; - bs_interface_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${capitalize_file module}.mli" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${uncapitalize_file module}.mli" - } - ]; - bs_implementation_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${capitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${uncapitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${capitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${uncapitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${capitalize_file module}.mly" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${uncapitalize_file module}.mly" - } - ]; - bs_c_sources = []; - bs_data_files = []; - bs_findlib_extra_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 = ["Memory_interface"; "Memory_client"]; - lib_pack = false; - lib_internal_modules = []; - lib_findlib_parent = Some "xcp"; - lib_findlib_name = Some "memory"; - lib_findlib_directory = None; - lib_findlib_containers = [] - }); - Library - ({ - cs_name = "xapi_v6"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = [(OASISExpr.EBool true, true)]; - bs_install = [(OASISExpr.EBool true, true)]; - bs_path = "v6"; - bs_compiled_object = Best; - bs_build_depends = - [ - InternalLibrary "xcp"; - FindlibPackage ("threads", None); - FindlibPackage ("rpclib", None) - ]; - bs_build_tools = [ExternalTool "ocamlbuild"]; - bs_interface_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${capitalize_file module}.mli" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${uncapitalize_file module}.mli" - } - ]; - bs_implementation_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${capitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${uncapitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${capitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${uncapitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${capitalize_file module}.mly" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${uncapitalize_file module}.mly" - } - ]; - bs_c_sources = []; - bs_data_files = []; - bs_findlib_extra_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 = ["V6_interface"; "V6_client"]; - lib_pack = false; - lib_internal_modules = []; - lib_findlib_parent = Some "xcp"; - lib_findlib_name = Some "v6"; - lib_findlib_directory = None; - lib_findlib_containers = [] - }); - Executable - ({ - cs_name = "channel_helper"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = [(OASISExpr.EBool true, true)]; - bs_install = [(OASISExpr.EBool true, false)]; - bs_path = "lib"; - bs_compiled_object = Best; - bs_build_depends = - [ - InternalLibrary "xcp"; - FindlibPackage ("lwt", None); - FindlibPackage ("lwt.unix", None); - FindlibPackage ("cmdliner", None) - ]; - bs_build_tools = [ExternalTool "ocamlbuild"]; - bs_interface_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${capitalize_file module}.mli" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${uncapitalize_file module}.mli" - } - ]; - bs_implementation_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${capitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${uncapitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${capitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${uncapitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${capitalize_file module}.mly" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${uncapitalize_file module}.mly" - } - ]; - bs_c_sources = []; - bs_data_files = []; - bs_findlib_extra_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, [])] - }, - {exec_custom = true; exec_main_is = "channel_helper.ml"}); - Executable - ({ - cs_name = "lib_test"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = [(OASISExpr.EBool true, true)]; - bs_install = [(OASISExpr.EBool true, false)]; - bs_path = "lib_test"; - bs_compiled_object = Best; - bs_build_depends = - [ - FindlibPackage ("lwt", None); - FindlibPackage ("lwt.unix", None); - InternalLibrary "xcp"; - InternalLibrary "xcp_xen"; - FindlibPackage ("threads", None); - FindlibPackage ("rpclib", None); - FindlibPackage ("oUnit", None); - InternalLibrary "xcp_updates" - ]; - bs_build_tools = [ExternalTool "ocamlbuild"]; - bs_interface_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${capitalize_file module}.mli" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${uncapitalize_file module}.mli" - } - ]; - bs_implementation_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${capitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${uncapitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${capitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${uncapitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${capitalize_file module}.mly" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${uncapitalize_file module}.mly" - } - ]; - bs_c_sources = []; - bs_data_files = []; - bs_findlib_extra_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, [])] - }, - {exec_custom = true; exec_main_is = "test.ml"}); - Test - ({ - cs_name = "lib_test"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - test_type = (`Test, "custom", Some "0.4"); - test_command = - [ - (OASISExpr.EBool true, - ("./test.native", ["-runner"; "sequential"])) - ]; - test_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; - test_working_directory = None; - test_run = - [ - (OASISExpr.ENot (OASISExpr.EFlag "tests"), false); - (OASISExpr.EFlag "tests", true) - ]; - test_tools = [ExternalTool "ocamlbuild"] - }); - Executable - ({ - cs_name = "example"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = [(OASISExpr.EBool true, true)]; - bs_install = [(OASISExpr.EBool true, false)]; - bs_path = "example"; - bs_compiled_object = Best; - bs_build_depends = - [ - FindlibPackage ("lwt", None); - FindlibPackage ("lwt.unix", None); - InternalLibrary "xcp"; - FindlibPackage ("rpclib", None) - ]; - bs_build_tools = [ExternalTool "ocamlbuild"]; - bs_interface_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${capitalize_file module}.mli" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${uncapitalize_file module}.mli" - } - ]; - bs_implementation_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${capitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${uncapitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${capitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${uncapitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${capitalize_file module}.mly" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${uncapitalize_file module}.mly" - } - ]; - bs_c_sources = []; - bs_data_files = []; - bs_findlib_extra_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, [])] - }, - {exec_custom = true; exec_main_is = "example.ml"}); - Executable - ({ - cs_name = "memory_cli"; - cs_data = PropList.Data.create (); - cs_plugin_data = [] - }, - { - bs_build = [(OASISExpr.EBool true, true)]; - bs_install = [(OASISExpr.EBool true, false)]; - bs_path = "memory"; - bs_compiled_object = Best; - bs_build_depends = - [ - InternalLibrary "xcp_memory"; - FindlibPackage ("cmdliner", None); - FindlibPackage ("rpclib.cmdliner", None); - FindlibPackage ("rpclib.markdown", None) - ]; - bs_build_tools = [ExternalTool "ocamlbuild"]; - bs_interface_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${capitalize_file module}.mli" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mli" - ]; - origin = "${uncapitalize_file module}.mli" - } - ]; - bs_implementation_patterns = - [ - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${capitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".ml" - ]; - origin = "${uncapitalize_file module}.ml" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${capitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mll" - ]; - origin = "${uncapitalize_file module}.mll" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("capitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${capitalize_file module}.mly" - }; - { - OASISSourcePatterns.Templater.atoms = - [ - OASISSourcePatterns.Templater.Text ""; - OASISSourcePatterns.Templater.Expr - (OASISSourcePatterns.Templater.Call - ("uncapitalize_file", - OASISSourcePatterns.Templater.Ident - "module")); - OASISSourcePatterns.Templater.Text ".mly" - ]; - origin = "${uncapitalize_file module}.mly" - } - ]; - bs_c_sources = []; - bs_data_files = []; - bs_findlib_extra_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, [])] - }, - {exec_custom = false; exec_main_is = "memory_cli.ml"}) - ]; - disable_oasis_section = []; - conf_type = (`Configure, "internal", Some "0.4"); - conf_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; - build_type = (`Build, "ocamlbuild", Some "0.4"); - build_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; - install_type = (`Install, "internal", Some "0.4"); - install_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; - uninstall_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; - clean_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; - distclean_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; - plugins = [(`Extra, "META", Some "0.2")]; - schema_data = PropList.Data.create (); - plugin_data = [] - }; - oasis_fn = Some "_oasis"; - oasis_version = "0.4.10"; - oasis_digest = Some "\251\026E\240\236!\212\127l\227y\238\243 \183$"; - oasis_exec = None; - oasis_setup_args = []; - setup_update = false - };; - -let setup () = BaseSetup.setup setup_t;; - -# 9055 "setup.ml" -let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t -open BaseCompat.Compat_0_4 -(* OASIS_STOP *) -let () = setup ();; diff --git a/storage/META b/storage/META deleted file mode 100644 index 90775d00..00000000 --- a/storage/META +++ /dev/null @@ -1,22 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: 4499b3718ade0a9d045a86b4aa1c08be) -version = "0.1" -description = "Interface definitions for XCP hosts" -requires = "uri re cohttp xmlm unix" -archive(byte) = "xcp.cma" -archive(byte, plugin) = "xcp.cma" -archive(native) = "xcp.cmxa" -archive(native, plugin) = "xcp.cmxs" -exists_if = "xcp.cma" -package "storage" ( - version = "0.1" - description = "Interface definitions for XCP hosts" - requires = "xcp rpclib rpclib.syntax" - archive(byte) = "xcp_storage.cma" - archive(byte, plugin) = "xcp_storage.cma" - archive(native) = "xcp_storage.cmxa" - archive(native, plugin) = "xcp_storage.cmxs" - exists_if = "xcp_storage.cma" -) -# OASIS_STOP - diff --git a/storage/jbuild b/storage/jbuild new file mode 100644 index 00000000..aa13554f --- /dev/null +++ b/storage/jbuild @@ -0,0 +1,54 @@ +(* -*- tuareg -*- *) +#require "unix" + +let flags = function +| [] -> "" +| pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" + +let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"] +let rewriters_ppx = ["ppx_deriving_rpc"; "ppx_sexp_conv"] + +let () = Printf.ksprintf Jbuild_plugin.V1.send {| +(jbuild_version 1) + +(library + ((name xcp_storage_interface_types) + (public_name xcp.storage.interface.types) + (flags (:standard -w -39 %s)) + (modules (vdi_automaton)) + (libraries (xcp threads rpclib)) + (wrapped false))) + +(library + ((name xcp_storage_interface) + (public_name xcp.storage.interface) + (flags (:standard -w -39 %s)) + (modules (storage_interface)) + (libraries (xcp threads rpclib xcp_storage_interface_types)) + (wrapped false))) + +(library + ((name xcp_storage) + (public_name xcp.storage) + (flags (:standard -w -39 %s)) + (modules (:standard \ storage_test storage_interface vdi_automaton)) + (libraries (xcp threads rpclib xcp_storage_interface xcp_storage_interface_types)) + (wrapped false))) + +(executable + ((name storage_test) + (flags (:standard -w -39 %s)) + (modules (storage_test)) + (libraries (xcp xcp_storage oUnit cmdliner)))) + +|} (flags rewriters_ppx) (flags rewriters_camlp4) (flags rewriters_ppx) (flags rewriters_ppx) diff --git a/storage/xcp_storage.mldylib b/storage/xcp_storage.mldylib deleted file mode 100644 index 0cde4951..00000000 --- a/storage/xcp_storage.mldylib +++ /dev/null @@ -1,8 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: e657684e087ec3889e61d5a033ea6ad8) -Storage_interface -Vdi_automaton -Storage_client -Storage_skeleton -Storage_skeleton_test -# OASIS_STOP diff --git a/storage/xcp_storage.mllib b/storage/xcp_storage.mllib deleted file mode 100644 index 0cde4951..00000000 --- a/storage/xcp_storage.mllib +++ /dev/null @@ -1,8 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: e657684e087ec3889e61d5a033ea6ad8) -Storage_interface -Vdi_automaton -Storage_client -Storage_skeleton -Storage_skeleton_test -# OASIS_STOP diff --git a/v6/jbuild b/v6/jbuild new file mode 100644 index 00000000..cce78738 --- /dev/null +++ b/v6/jbuild @@ -0,0 +1,40 @@ +(* -*- tuareg -*- *) +#require "unix" + +let flags = function +| [] -> "" +| pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" + +let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"] +let rewriters_ppx = ["ppx_deriving_rpc"; "ppx_sexp_conv"] + +let () = Printf.ksprintf Jbuild_plugin.V1.send {| +(jbuild_version 1) + +(library + ((name xapi_v6_interface) + (public_name xcp.v6.interface) + (modules (v6_interface)) + (flags (:standard -w -39 %s)) + (libraries (xcp threads rpclib)) + (wrapped false))) + +(library + ((name xapi_v6) + (public_name xcp.v6) + (modules (:standard \ v6_interface)) + (flags (:standard -w -39 %s)) + (libraries (xcp threads rpclib xapi_v6_interface)) + (wrapped false))) + +|} (flags rewriters_camlp4) (flags rewriters_ppx) diff --git a/v6/xapi_v6.mldylib b/v6/xapi_v6.mldylib deleted file mode 100644 index 20adab6d..00000000 --- a/v6/xapi_v6.mldylib +++ /dev/null @@ -1,5 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: ea6a705e628fece9d1850106f5dc5d63) -V6_interface -V6_client -# OASIS_STOP diff --git a/v6/xapi_v6.mllib b/v6/xapi_v6.mllib deleted file mode 100644 index 20adab6d..00000000 --- a/v6/xapi_v6.mllib +++ /dev/null @@ -1,5 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: ea6a705e628fece9d1850106f5dc5d63) -V6_interface -V6_client -# OASIS_STOP diff --git a/opam b/xcp.opam similarity index 79% rename from opam rename to xcp.opam index 1f22a04a..d51c74d5 100644 --- a/opam +++ b/xcp.opam @@ -5,21 +5,11 @@ bug-reports: "https://github.com/xapi-project/xcp-idl/issues" dev-repo: "git://github.com/xapi-project/xcp-idl" maintainer: "xen-api@lists.xen.org" tags: [ "org:xapi-project" ] -build: [ - [make "all"] -] -build-test: [ - [make "test"] -] -install: [ - [make "install"] -] -remove: [ - ["ocamlfind" "remove" "xcp"] -] +build: [[ "jbuilder" "build" "-p" name "-j" jobs ]] +build-test: ["jbuilder" "runtest" "-p" name] depends: [ "ocamlfind" {build} - "ocamlbuild" {build} + "jbuilder" {build & >= "1.0+beta11"} "base-threads" "base-unix" "uri" @@ -39,4 +29,3 @@ depends: [ "ppx_sexp_conv" "sexplib" ] - diff --git a/xen/jbuild b/xen/jbuild new file mode 100644 index 00000000..826e0e2d --- /dev/null +++ b/xen/jbuild @@ -0,0 +1,45 @@ +(* -*- tuareg -*- *) +#require "unix" + +let flags = function +| [] -> "" +| pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" + +let rewriters_ppx = ["ppx_deriving_rpc"; "ppx_sexp_conv"] +let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"] + +let () = Printf.ksprintf Jbuild_plugin.V1.send {| +(jbuild_version 1) + +(library + ((name xcp_xen_interface_types) + (public_name xcp.xen.interface.types) + (modules (xenops_types device_number)) + (flags (:standard -w -39 %s)) + (libraries (xcp threads rpclib)) + (wrapped false))) +(library + ((name xcp_xen_interface) + (public_name xcp.xen.interface) + (modules (xenops_interface)) + (flags (:standard -w -39 %s)) + (libraries (xcp threads rpclib xcp_xen_interface_types)) + (wrapped false))) +(library + ((name xcp_xen) + (public_name xcp.xen) + (modules (:standard \ xenops_interface xenops_types device_number)) + (flags (:standard -w -39 %s)) + (libraries (xcp threads rpclib xcp_xen_interface)) + (wrapped false))) +|} (flags rewriters_ppx) (flags rewriters_camlp4) (flags rewriters_ppx) diff --git a/xen/xcp_xen.mldylib b/xen/xcp_xen.mldylib deleted file mode 100644 index 6f793f24..00000000 --- a/xen/xcp_xen.mldylib +++ /dev/null @@ -1,7 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: 6feea5180d09d090aa7013e32a5d9b7d) -Xenops_interface -Xenops_types -Xenops_client -Device_number -# OASIS_STOP diff --git a/xen/xcp_xen.mllib b/xen/xcp_xen.mllib deleted file mode 100644 index 6f793f24..00000000 --- a/xen/xcp_xen.mllib +++ /dev/null @@ -1,7 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: 6feea5180d09d090aa7013e32a5d9b7d) -Xenops_interface -Xenops_types -Xenops_client -Device_number -# OASIS_STOP From e71f678043ef13da917d7125a99a104ec06212b1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:39:19 +0100 Subject: [PATCH 02/20] fix jbuild --dev warnings for unused values MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- lib/channel_helper.ml | 12 ++++++------ lib/cohttp_posix_io.ml | 2 +- lib/debug.ml | 2 +- lib/posix_channel.ml | 6 +++--- lib/updates.ml | 14 +++++++------- lib/xcp_service.ml | 10 +++++----- lib_test/scheduler_test.ml | 2 +- lib_test/task_server_test.ml | 14 +++++++------- lib_test/updates_test.ml | 14 +++++++------- xen/xenops_client.ml | 2 +- 10 files changed, 39 insertions(+), 39 deletions(-) diff --git a/lib/channel_helper.ml b/lib/channel_helper.ml index 55ab02a7..133f3ef2 100644 --- a/lib/channel_helper.ml +++ b/lib/channel_helper.ml @@ -21,9 +21,9 @@ let copy_all src dst = in loop () let proxy a b = - let copy id src dst = + let copy _id src dst = Lwt.catch (fun () -> copy_all src dst) - (fun e -> + (fun _e -> (try Lwt_unix.shutdown src Lwt_unix.SHUTDOWN_RECEIVE with _ -> ()); (try Lwt_unix.shutdown dst Lwt_unix.SHUTDOWN_SEND with _ -> ()); return ()) in @@ -78,7 +78,7 @@ let help = [ ] (* Commands *) -let advertise_t common_options_t proxy_socket = +let advertise_t _common_options_t proxy_socket = let s_ip = Lwt_unix.socket Lwt_unix.PF_INET Lwt_unix.SOCK_STREAM 0 in Lwt_unix.bind s_ip (Lwt_unix.ADDR_INET(Unix.inet_addr_of_string !ip, 0)); @@ -110,11 +110,11 @@ let advertise_t common_options_t proxy_socket = Printf.fprintf stdout "%s\n%!" (Jsonrpc.to_string (Xcp_channel.rpc_of_protocols protocols)); let t_ip = - Lwt_unix.accept s_ip >>= fun (fd, peer) -> + Lwt_unix.accept s_ip >>= fun (fd, _peer) -> Lwt_unix.close s_ip >>= fun () -> proxy fd (Lwt_unix.of_unix_file_descr proxy_socket) in let t_unix = - Lwt_unix.accept s_unix >>= fun (fd, peer) -> + Lwt_unix.accept s_unix >>= fun (fd, _peer) -> let buffer = String.make (String.length token) '\000' in let io_vector = Lwt_unix.io_vector ~buffer ~offset:0 ~length:(String.length buffer) in Lwt_unix.recv_msg ~socket:fd ~io_vectors:[io_vector] >>= fun (n, fds) -> @@ -148,7 +148,7 @@ let advertise_cmd = Term.(ret(pure advertise $ common_options_t $ fd)), Term.info "advertise" ~sdocs:_common_options ~doc ~man -let connect_t common_options_t = +let connect_t _common_options_t = Lwt_io.read_line_opt Lwt_io.stdin >>= (function | None -> return "" | Some x -> return x) >>= fun advertisement -> let open Xcp_channel in let fd = Lwt_unix.of_unix_file_descr (file_descr_of_t (t_of_rpc (Jsonrpc.of_string advertisement))) in diff --git a/lib/cohttp_posix_io.ml b/lib/cohttp_posix_io.ml index d41c0070..d5c518af 100644 --- a/lib/cohttp_posix_io.ml +++ b/lib/cohttp_posix_io.ml @@ -119,7 +119,7 @@ module Unbuffered_IO = struct let write oc x = ignore(Unix.write oc x 0 (String.length x)) - let flush oc = () + let flush _oc = () end module Buffered_IO = struct diff --git a/lib/debug.ml b/lib/debug.ml index 23553b2c..897e2ce9 100644 --- a/lib/debug.ml +++ b/lib/debug.ml @@ -164,7 +164,7 @@ let rec split_c c str = String.sub str 0 i :: (split_c c (String.sub str (i+1) (String.length str - i - 1))) with Not_found -> [str] -let log_backtrace exn bt = +let log_backtrace exn _bt = Backtrace.is_important exn; let all = split_c '\n' (Backtrace.(to_string_hum (remove exn))) in (* Write to the log line at a time *) diff --git a/lib/posix_channel.ml b/lib/posix_channel.ml index bf979617..82812cc7 100644 --- a/lib/posix_channel.ml +++ b/lib/posix_channel.ml @@ -40,7 +40,7 @@ module CBuf = struct (* Offset of the character after the substring *) let next = min (String.length x.buffer) (x.start + x.len) in let len = next - x.start in - let written = try Unix.single_write fd x.buffer x.start len with e -> x.w_closed <- true; len in + let written = try Unix.single_write fd x.buffer x.start len with _e -> x.w_closed <- true; len in drop x written let read (x: t) fd = @@ -149,7 +149,7 @@ let send proxy_socket = (fun () -> let readable, _, _ = Unix.select [ s_ip; s_unix ] [] [] (-1.0) in if List.mem s_unix readable then begin - let fd, peer = Unix.accept s_unix in + let fd, _peer = Unix.accept s_unix in to_close := fd :: !to_close; let buffer = String.make (String.length token) '\000' in let n = Unix.recv fd buffer 0 (String.length buffer) [] in @@ -159,7 +159,7 @@ let send proxy_socket = () end end else if List.mem s_ip readable then begin - let fd, peer = Unix.accept s_ip in + let fd, _peer = Unix.accept s_ip in List.iter close !to_close; to_close := fd :: !to_close; diff --git a/lib/updates.ml b/lib/updates.ml index 4baa8844..85278bda 100644 --- a/lib/updates.ml +++ b/lib/updates.ml @@ -86,7 +86,7 @@ module Updates = functor(Interface : INTERFACE) -> struct let get from t = (* [from] is the id of the most recent event already seen *) let get_from_map map = - let before, after = M.partition (fun _ time -> time <= from) map in + let _before, after = M.partition (fun _ time -> time <= from) map in let xs, last = M.fold (fun key v (acc, m) -> (key, v) :: acc, max m v) after ([], from) in let xs = List.sort (fun (_, v1) (_, v2) -> compare v1 v2) xs |> List.map fst @@ -165,7 +165,7 @@ module Updates = functor(Interface : INTERFACE) -> struct ) ) (fun () -> Opt.iter (Scheduler.cancel t.s) id)) - let last_id dbg t = + let last_id _dbg t = Mutex.execute t.m (fun () -> U.last_id t.u @@ -174,7 +174,7 @@ module Updates = functor(Interface : INTERFACE) -> struct let add x t = Mutex.execute t.m (fun () -> - let result, id = U.add x t.u in + let result, _id = U.add x t.u in t.u <- result; Condition.broadcast t.c ) @@ -182,7 +182,7 @@ module Updates = functor(Interface : INTERFACE) -> struct let remove x t = Mutex.execute t.m (fun () -> - let result, id = U.remove x t.u in + let result, _id = U.remove x t.u in t.u <- result; Condition.broadcast t.c ) @@ -190,7 +190,7 @@ module Updates = functor(Interface : INTERFACE) -> struct let filter f t = Mutex.execute t.m (fun () -> - let result, id = U.filter (fun x y -> f x) t.u in + let result, _id = U.filter (fun x _y -> f x) t.u in t.u <- result; Condition.broadcast t.c ) @@ -198,14 +198,14 @@ module Updates = functor(Interface : INTERFACE) -> struct let inject_barrier id filter t = Mutex.execute t.m (fun () -> - let result, id = U.inject_barrier id filter t.u in + let result, _id = U.inject_barrier id filter t.u in t.u <- result; Condition.broadcast t.c) let remove_barrier id t = Mutex.execute t.m (fun () -> - let result, id = U.remove_barrier id t.u in + let result, _id = U.remove_barrier id t.u in t.u <- result; Condition.broadcast t.c) diff --git a/lib/xcp_service.ml b/lib/xcp_service.ml index 0a55605a..de6c9429 100644 --- a/lib/xcp_service.ml +++ b/lib/xcp_service.ml @@ -263,7 +263,7 @@ let canonicalise x = (* Search the PATH and XCP_PATH for the executable *) let paths = split_c ':' (Sys.getenv "PATH") in let first_hit = List.fold_left (fun found path -> match found with - | Some hit -> found + | Some _hit -> found | None -> let possibility = Filename.concat path x in if Sys.file_exists possibility @@ -301,7 +301,7 @@ let startswith prefix x = let prefix' = String.length prefix and x' = String.length x in prefix' <= x' && (String.sub x 0 prefix' = prefix) -let configure_common ~name ~version ~doc ~options ~resources arg_parse_fn = +let configure_common ~options ~resources arg_parse_fn = let resources = default_resources @ resources in let config_spec = common_options @ options @ (to_opt resources) in @@ -344,7 +344,7 @@ let configure_common ~name ~version ~doc ~options ~resources arg_parse_fn = let configure ?(options=[]) ?(resources=[]) () = try - configure_common ~name:"Unknown" ~version:"Unknown" ~doc:"Unknown" ~options ~resources + configure_common ~options ~resources (fun config_spec -> Arg.parse (Arg.align (arg_spec config_spec)) (fun _ -> failwith "Invalid argument") @@ -360,7 +360,7 @@ type ('a, 'b) error = [ let configure2 ~name ~version ~doc ?(options=[]) ?(resources=[]) () = try - configure_common ~name ~version ~doc ~options ~resources + configure_common ~options ~resources (fun config_spec -> match Term.eval (command_of ~name ~version ~doc config_spec) with | `Ok () -> () @@ -439,7 +439,7 @@ let http_handler call_of_string string_of_response process s = "content-length", string_of_int content_length; ] in let response = Cohttp.Response.make ~version:`HTTP_1_1 ~status:`Not_found ~headers ~encoding:(Cohttp.Transfer.Fixed (Int64.of_int content_length)) () in - Response.write (fun t -> ()) response oc + Response.write (fun _t -> ()) response oc end let ign_thread (t:Thread.t) = ignore t diff --git a/lib_test/scheduler_test.ml b/lib_test/scheduler_test.ml index 2045177f..c1658b57 100644 --- a/lib_test/scheduler_test.ml +++ b/lib_test/scheduler_test.ml @@ -97,7 +97,7 @@ let test_one_shot_cancel () = a test function that has been injected *) let test_dump () = let after = ref None in - let before = Unix.gettimeofday () in + let _before = Unix.gettimeofday () in let _ = Scheduler.one_shot global_scheduler (Scheduler.Delta 1) "test_dump" (fun () -> after := Some (Unix.gettimeofday ())) in let dump = Scheduler.Dump.make global_scheduler in diff --git a/lib_test/task_server_test.ml b/lib_test/task_server_test.ml index 92c6d8f5..92178d2a 100644 --- a/lib_test/task_server_test.ml +++ b/lib_test/task_server_test.ml @@ -55,14 +55,14 @@ module T = Task_server.Task(TestInterface) (* Test that we can add a task and retrieve it from the task list *) let test_add () = let t = T.empty () in - let task = T.add t "dbg" (fun task -> Some "done") in + let task = T.add t "dbg" (fun _task -> Some "done") in let ts = T.list t in assert_bool "Task in task list" (List.mem task ts) (* Test that destroying a task removes it from the task list *) let test_destroy () = let t = T.empty () in - let task = T.add t "dbg" (fun task -> Some "done") in + let task = T.add t "dbg" (fun _task -> Some "done") in T.destroy task; let ts = T.list t in assert_bool "Task not in task list" (not (List.mem task ts)) @@ -74,7 +74,7 @@ let test_run () = let t = T.empty () in let start = Unix.gettimeofday () in Thread.delay 0.001; - let task = T.add t "dbg" (fun task -> Thread.delay 0.001; Some "done") in + let task = T.add t "dbg" (fun _task -> Thread.delay 0.001; Some "done") in T.run task; let t' = T.to_interface_task task in assert_bool "Task ctime" (t'.TestInterface.Task.ctime > start); @@ -89,7 +89,7 @@ let test_run () = let test_raise () = Debug.disable "task_server"; let t = T.empty () in - let task = T.add t "dbg" (fun task -> raise (TestInterface.Internal_error "test")) in + let task = T.add t "dbg" (fun _task -> raise (TestInterface.Internal_error "test")) in T.run task; let t' = T.to_interface_task task in assert_bool "Task result" @@ -224,13 +224,13 @@ let test_subtasks () = (fun task -> let _ : int = T.with_subtask task "subtask1" (fun () -> 0) in Some "done") in - let id = T.id_of_handle task in + let _id = T.id_of_handle task in T.run task; assert_bool "Subtasks" ((List.hd (T.to_interface_task task).TestInterface.Task.subtasks |> fst) = "subtask1"); assert_bool "Task result" (match (T.to_interface_task task).TestInterface.Task.state with - | TestInterface.Task.Completed {TestInterface.Task.result=Some r; duration} -> + | TestInterface.Task.Completed {TestInterface.Task.result=Some r; duration=_} -> r = "done" | _ -> false) @@ -290,7 +290,7 @@ let test_cancel_trigger () = | _ -> false); assert_bool "Task result" (match (T.to_interface_task task1).TestInterface.Task.state with - | TestInterface.Task.Completed {TestInterface.Task.result=Some r; duration} -> + | TestInterface.Task.Completed {TestInterface.Task.result=Some r; duration=_} -> r = "done" | _ -> false); assert_bool "cancel points xxx" (!xxx = 0); diff --git a/lib_test/updates_test.ml b/lib_test/updates_test.ml index 8c93f8c7..1a02ab39 100644 --- a/lib_test/updates_test.ml +++ b/lib_test/updates_test.ml @@ -22,13 +22,13 @@ module M = Updates.Updates(TestInterface) let test_add () = let u = M.empty scheduler in M.add update_a u; - let (barriers,updates,id) = M.get "dbg" None (Some 0) u in + let (_barriers,updates,_id) = M.get "dbg" None (Some 0) u in assert_bool "Update returned" (List.length updates = 1 && List.exists (fun x -> x=update_a) updates) (* Tests that no updates are returned if none exist *) let test_noadd () = let u = M.empty scheduler in - let (barriers,updates,id) = M.get "dbg" None (Some 0) u in + let (_barriers,updates,_id) = M.get "dbg" None (Some 0) u in assert_bool "Update returned" (List.length updates = 0) (* Tests that we can remove an update, and that it's not then returned by 'get' *) @@ -36,7 +36,7 @@ let test_remove () = let u = M.empty scheduler in M.add update_a u; M.remove update_a u; - let (barriers,updates,id) = M.get "dbg" None (Some 0) u in + let (_barriers,updates,_id) = M.get "dbg" None (Some 0) u in assert_bool "Update returned" (List.length updates = 0) (* Tests that, if we specify a timeout, the 'get' call returns the empty @@ -76,7 +76,7 @@ let test_inject_barrier () = M.inject_barrier 1 (fun _ _ -> true) u; M.add update_a u; M.add update_c u; - let (barriers,updates,id) = M.get "dbg" None (Some 1) u in + let (barriers,updates,_id) = M.get "dbg" None (Some 1) u in assert_bool "Barrier returned" (List.length barriers = 1); assert_bool "Barriers contains our barrier" (List.exists (fun x -> fst x = 1) barriers); let our_barrier = List.hd barriers in @@ -98,7 +98,7 @@ let test_remove_barrier () = M.add update_a u; M.add update_c u; M.remove_barrier 1 u; - let (barriers,updates,id) = M.get "dbg" None (Some 1) u in + let (barriers,updates,_id) = M.get "dbg" None (Some 1) u in assert_bool "Barrier returned" (List.length barriers = 0); assert_bool "Updates contain all updates" (List.nth updates 0 = update_b && @@ -115,7 +115,7 @@ let test_inject_barrier_rpc () = M.inject_barrier 1 (fun _ _ -> true) u; M.add update_a u; M.add update_c u; - let (barriers,updates,id) = M.get "dbg" None (Some 1) u in + let (barriers,updates,_id) = M.get "dbg" None (Some 1) u in assert_bool "Barrier returned" (List.length barriers = 1); assert_bool "Barriers contains our barrier" (List.exists (fun x -> fst x = 1) barriers); let our_barrier = List.hd barriers in @@ -150,7 +150,7 @@ let test_filter () = M.add update_a u; M.add update_b u; M.filter (function | Foo "a" -> true | _ -> false) u; - let (_,updates1,id) = M.get "dbg" None (Some 1) u in + let (_,updates1,_id) = M.get "dbg" None (Some 1) u in assert_bool "Updates contain correct updates" (List.nth updates1 0 = update_a && List.length updates1 = 1) diff --git a/xen/xenops_client.ml b/xen/xenops_client.ml index 2c93ee0c..8223380e 100644 --- a/xen/xenops_client.ml +++ b/xen/xenops_client.ml @@ -59,5 +59,5 @@ let wait_for_task dbg id = if not(task_ended dbg id) then event_wait dbg ~from finished; id -let ignore_task (t: Task.t) = () +let ignore_task (_: Task.t) = () From cb4d2a5a5d1f90e034e4f9edfe3c48a51cfc8034 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:39:22 +0100 Subject: [PATCH 03/20] jbuild --dev: drop unused opens MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- example/example.ml | 1 - lib/updates.ml | 1 - memory/memory_cli.ml | 2 -- storage/storage_interface.ml | 1 - xen/xenops_interface.ml | 1 - 5 files changed, 6 deletions(-) diff --git a/example/example.ml b/example/example.ml index cf4fcf05..68144504 100644 --- a/example/example.ml +++ b/example/example.ml @@ -14,7 +14,6 @@ open Xcp_service module D = Debug.Make(struct let name = "example" end) -open D let ls = ref "/bin/ls" let sh = ref "/bin/sh" diff --git a/lib/updates.ml b/lib/updates.ml index 85278bda..76dfcd6e 100644 --- a/lib/updates.ml +++ b/lib/updates.ml @@ -5,7 +5,6 @@ open Stdext open Pervasiveext module D = Debug.Make(struct let name = "updates" end) -open D module type INTERFACE = sig val service_name : string diff --git a/memory/memory_cli.ml b/memory/memory_cli.ml index 266f7b37..7e35a844 100644 --- a/memory/memory_cli.ml +++ b/memory/memory_cli.ml @@ -1,8 +1,6 @@ (* Memory CLI *) open Memory_interface -open Xcp_client -open Memory_client module Cmds = API(Cmdlinergen.Gen ()) diff --git a/storage/storage_interface.ml b/storage/storage_interface.ml index b70984d6..627e061e 100644 --- a/storage/storage_interface.ml +++ b/storage/storage_interface.ml @@ -26,7 +26,6 @@ let set_sockets_dir x = let uri () = "file:" ^ !default_path -open Vdi_automaton (** Primary key identifying the SR *) type sr = string diff --git a/xen/xenops_interface.ml b/xen/xenops_interface.ml index 49749e86..59c3614a 100644 --- a/xen/xenops_interface.ml +++ b/xen/xenops_interface.ml @@ -15,7 +15,6 @@ * @group Xenops *) -open Sexplib.Std include Xenops_types.TopLevel let service_name = "xenops" From b80d41919c4ea4446753ae1bed06d57cd25ed17b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:39:26 +0100 Subject: [PATCH 04/20] jbuilder --dev: drop unused code MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit These functions/types are declared but not exposed through the mli Signed-off-by: Edwin Török --- lib/cohttp_posix_io.ml | 1 - lib/posix_channel.ml | 6 ------ lib/scheduler.ml | 2 +- lib/syslog.ml | 1 - lib/syslog_stubs.c | 4 ---- lib/task_server.ml | 2 -- lib/xcp_service.ml | 45 ---------------------------------------- lib_test/updates_test.ml | 1 - 8 files changed, 1 insertion(+), 61 deletions(-) diff --git a/lib/cohttp_posix_io.ml b/lib/cohttp_posix_io.ml index d5c518af..4d8bf35b 100644 --- a/lib/cohttp_posix_io.ml +++ b/lib/cohttp_posix_io.ml @@ -55,7 +55,6 @@ module Unbuffered_IO = struct if c = x.marker.[x.i] then x.i <- x.i + 1 else x.i <- 0 let remaining x = String.length x.marker - x.i let matched x = x.i = String.length x.marker - let to_string x = Printf.sprintf "%d" x.i end in let marker = Scanner.make end_of_headers in diff --git a/lib/posix_channel.ml b/lib/posix_channel.ml index 82812cc7..fd3e952b 100644 --- a/lib/posix_channel.ml +++ b/lib/posix_channel.ml @@ -1,8 +1,6 @@ let my_domid = 0 (* TODO: figure this out *) -exception Short_write of int * int exception End_of_file -exception No_useful_protocol exception Channel_setup_failed module CBuf = struct @@ -92,11 +90,7 @@ let finally f g = g (); raise e -let file_descr_of_int (x: int) : Unix.file_descr = - Obj.magic x (* Keep this in sync with ocaml's file_descr type *) - let ip = ref "127.0.0.1" -let unix = ref "/tmp" let send proxy_socket = let to_close = ref [] in diff --git a/lib/scheduler.ml b/lib/scheduler.ml index 4bda89ce..8af9868e 100644 --- a/lib/scheduler.ml +++ b/lib/scheduler.ml @@ -115,7 +115,7 @@ type t = { type time = | Absolute of int64 - | Delta of int [@@deriving rpc] + | Delta of int (*type t = int64 * int [@@deriving rpc]*) diff --git a/lib/syslog.ml b/lib/syslog.ml index 097b8a3e..b176cd2d 100644 --- a/lib/syslog.ml +++ b/lib/syslog.ml @@ -13,7 +13,6 @@ *) type level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug -type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid type facility = Auth | Authpriv | Cron | Daemon | Ftp | Kern | Local0 | Local1 | Local2 | Local3 | Local4 | Local5 | Local6 | Local7 diff --git a/lib/syslog_stubs.c b/lib/syslog_stubs.c index 408ecefe..d27b75c9 100644 --- a/lib/syslog_stubs.c +++ b/lib/syslog_stubs.c @@ -25,10 +25,6 @@ static int __syslog_level_table[] = { LOG_NOTICE, LOG_INFO, LOG_DEBUG }; -static int __syslog_options_table[] = { - LOG_CONS, LOG_NDELAY, LOG_NOWAIT, LOG_ODELAY, LOG_PERROR, LOG_PID -}; - static int __syslog_facility_table[] = { LOG_AUTH, LOG_AUTHPRIV, LOG_CRON, LOG_DAEMON, LOG_FTP, LOG_KERN, LOG_LOCAL0, LOG_LOCAL1, LOG_LOCAL2, LOG_LOCAL3, diff --git a/lib/task_server.ml b/lib/task_server.ml index 2c0f3d20..0a0a639d 100644 --- a/lib/task_server.ml +++ b/lib/task_server.ml @@ -177,8 +177,6 @@ module Task = functor (Interface : INTERFACE) -> struct let e = e |> Interface.exnty_of_exn |> Interface.Exception.rpc_of_exnty in item.state <- Interface.Task.Failed e - let exists_locked tasks id = SMap.mem id !(tasks.task_map) - let find_locked tasks id = try SMap.find id !(tasks.task_map) diff --git a/lib/xcp_service.ml b/lib/xcp_service.ml index de6c9429..5999292e 100644 --- a/lib/xcp_service.ml +++ b/lib/xcp_service.ml @@ -371,33 +371,6 @@ let configure2 ~name ~version ~doc ?(options=[]) ?(resources=[]) () = with Failure m -> `Error m -type 'a handler = - (string -> Rpc.call) -> - (Rpc.response -> string) -> - ('a -> Rpc.call -> Rpc.response) -> - Unix.file_descr -> - 'a-> - unit - -(* Apply a binary message framing protocol where the first 16 bytes are an integer length - stored as an ASCII string *) -let binary_handler call_of_string string_of_response process s context = - let ic = Unix.in_channel_of_descr s in - let oc = Unix.out_channel_of_descr s in - (* Read a 16 byte length encoded as a string *) - let len_buf = String.make 16 '\000' in - really_input ic len_buf 0 (String.length len_buf); - let len = int_of_string len_buf in - let msg_buf = String.make len '\000' in - really_input ic msg_buf 0 (String.length msg_buf); - let (request: Rpc.call) = call_of_string msg_buf in - let (result: Rpc.response) = process context request in - let msg_buf = string_of_response result in - let len_buf = Printf.sprintf "%016d" (String.length msg_buf) in - output_string oc len_buf; - output_string oc msg_buf; - flush oc - let http_handler call_of_string string_of_response process s = let ic = Unix.in_channel_of_descr s in let oc = Unix.out_channel_of_descr s in @@ -442,21 +415,11 @@ let http_handler call_of_string string_of_response process s = Response.write (fun _t -> ()) response oc end -let ign_thread (t:Thread.t) = ignore t let ign_int (t:int) = ignore t -let ign_string (t:string) = ignore t let default_raw_fn rpc_fn s = http_handler Xmlrpc.call_of_string Xmlrpc.string_of_response rpc_fn s -let accept_forever sock f = - ign_thread (Thread.create (fun () -> - while true do - let this_connection, _ = Unix.accept sock in - ign_thread (Thread.create (fun c -> finally (fun () -> f c) (fun () -> Unix.close c)) this_connection) - done - ) ()) - let mkdir_rec dir perm = let rec p_mkdir dir = let p_name = Filename.dirname dir in @@ -567,11 +530,3 @@ let maybe_daemonize ?start_fn () = daemonize ?start_fn () else Opt.iter (fun fn -> fn ()) start_fn - -let wait_forever () = - while true do - try - Thread.delay 60. - with e -> - debug "Thread.delay caught: %s" (Printexc.to_string e) - done diff --git a/lib_test/updates_test.ml b/lib_test/updates_test.ml index 1a02ab39..caa7efc5 100644 --- a/lib_test/updates_test.ml +++ b/lib_test/updates_test.ml @@ -170,7 +170,6 @@ let test_dump () = then only return events that were added _after_ the call to 'last_id' *) let test_last_id () = let u = M.empty scheduler in - let ok = ref false in M.add update_a u; M.add update_b u; let id = M.last_id "dbg" u in From 83e63b709989872d55a5a1eeca47d4101a310bac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:39:29 +0100 Subject: [PATCH 05/20] jbuilder --dev: fix printf format MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit %s does not accept a precision Signed-off-by: Edwin Török --- lib/debug.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/debug.ml b/lib/debug.ml index 897e2ce9..85402d06 100644 --- a/lib/debug.ml +++ b/lib/debug.ml @@ -114,7 +114,7 @@ let format include_time brand priority message = let name = match ThreadLocalTable.find names with Some x -> x | None -> "" in let task = match ThreadLocalTable.find tasks with Some x -> x | None -> "" in - Printf.sprintf "[%s%.5s|%s|%d %s|%s|%s] %s" + Printf.sprintf "[%s%5s|%s|%d %s|%s|%s] %s" (if include_time then gettimestring () else "") priority host id name task brand message From 82be0ac61ff932af4fb48c06bb1c5ef4f6a3dcaf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:39:33 +0100 Subject: [PATCH 06/20] jbuilder --dev: fix deprecated String usage MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- lib/scheduler.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/scheduler.ml b/lib/scheduler.ml index 8af9868e..49297b23 100644 --- a/lib/scheduler.ml +++ b/lib/scheduler.ml @@ -74,7 +74,7 @@ module Delay = struct pipe_out) in let r, _, _ = Unix.select [ pipe_out ] [] [] timeout in (* flush the single byte from the pipe *) - if r <> [] then ignore(Unix.read pipe_out (String.create 1) 0 1); + if r <> [] then ignore(Unix.read pipe_out (Bytes.create 1) 0 1); (* return true if we waited the full length of time, false if we were woken *) r = [] with Pre_signalled -> false From 4b7922fb1caf0cc879e57b1bb25a5d207394b056 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:39:35 +0100 Subject: [PATCH 07/20] jbuilder --dev: fix warning on free MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- lib/syslog_stubs.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/syslog_stubs.c b/lib/syslog_stubs.c index d27b75c9..3cca2186 100644 --- a/lib/syslog_stubs.c +++ b/lib/syslog_stubs.c @@ -53,7 +53,7 @@ value stub_openlog(value ident, value option, value facility) value stub_syslog(value facility, value level, value msg) { CAMLparam3(facility, level, msg); - const char *c_msg = strdup(String_val(msg)); + char *c_msg = strdup(String_val(msg)); int c_facility = __syslog_facility_table[Int_val(facility)] | __syslog_level_table[Int_val(level)]; From 0e51b61eb8e585111afc964a0f06fb70afd06783 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:39:38 +0100 Subject: [PATCH 08/20] jbuilder --dev: fix typo in test MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The tests pass either way, but partition2=partition2 looks like a typo. Signed-off-by: Edwin Török --- lib_test/device_number_test.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib_test/device_number_test.ml b/lib_test/device_number_test.ml index 209a269b..ae17fe8b 100644 --- a/lib_test/device_number_test.ml +++ b/lib_test/device_number_test.ml @@ -100,7 +100,7 @@ let test_2_way_convert = let equal_linux old_t new_t = match spec old_t, spec new_t with | (Ide, disk1, partition1), (Xen, disk2, partition2) - when disk1 = disk2 && partition2 = partition2 -> true + when disk1 = disk2 && partition1 = partition2 -> true | old_spec, new_spec -> old_spec = new_spec in let original = of_disk_number hvm disk_number in From 89afe85e40863a5b4f73931037e3f727f5429770 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:39:41 +0100 Subject: [PATCH 09/20] jbuilder --dev: disable warnings for some pieces of code MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit these warnings can't easily be fixed Signed-off-by: Edwin Török --- lib/xcp_channel.ml | 1 + lib/xcp_client.ml | 1 + storage/storage_skeleton.ml | 1 + 3 files changed, 3 insertions(+) diff --git a/lib/xcp_channel.ml b/lib/xcp_channel.ml index e815c86c..fa07fede 100644 --- a/lib/xcp_channel.ml +++ b/lib/xcp_channel.ml @@ -3,6 +3,7 @@ type t = Unix.file_descr let file_descr_of_t t = t let t_of_file_descr t = t +[@@@ocaml.warning "-34"] type protocols = Xcp_channel_protocol.t list [@@deriving rpc] let rpc_of_t fd = diff --git a/lib/xcp_client.ml b/lib/xcp_client.ml index c5bbec98..c81c1a8a 100644 --- a/lib/xcp_client.ml +++ b/lib/xcp_client.ml @@ -46,6 +46,7 @@ let split_colon str = [str] (* Use HTTP to frame RPC messages *) +[@@@ocaml.warning "-27"] let http_rpc string_of_call response_of_string ?(srcstr="unset") ?(dststr="unset") url call = let uri = Uri.of_string (url ()) in let req = string_of_call call in diff --git a/storage/storage_skeleton.ml b/storage/storage_skeleton.ml index e899e815..fe433a86 100644 --- a/storage/storage_skeleton.ml +++ b/storage/storage_skeleton.ml @@ -11,6 +11,7 @@ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. *) +[@@@ocaml.warning "-27"] let u x = raise (Storage_interface.Unimplemented x) From e7af86969c83c0cb9251242805e3a21f84b99ed0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:39:45 +0100 Subject: [PATCH 10/20] Switch to non-deprecated Lwt_unix.Versioned.bind_2 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The first bind could actually use bind_1 but that is deprecated too, just use the non-deprecated version in both places. Signed-off-by: Edwin Török --- lib/channel_helper.ml | 5 +++-- xcp.opam | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/lib/channel_helper.ml b/lib/channel_helper.ml index 133f3ef2..18f75b0a 100644 --- a/lib/channel_helper.ml +++ b/lib/channel_helper.ml @@ -81,7 +81,8 @@ let help = [ let advertise_t _common_options_t proxy_socket = let s_ip = Lwt_unix.socket Lwt_unix.PF_INET Lwt_unix.SOCK_STREAM 0 in - Lwt_unix.bind s_ip (Lwt_unix.ADDR_INET(Unix.inet_addr_of_string !ip, 0)); + (* INET socket, can't block *) + Lwt_unix.Versioned.bind_2 s_ip (Lwt_unix.ADDR_INET(Unix.inet_addr_of_string !ip, 0)) >>= fun () -> Lwt_unix.listen s_ip 5; let port = match Lwt_unix.getsockname s_ip with | Unix.ADDR_INET(_, port) -> port @@ -93,7 +94,7 @@ let advertise_t _common_options_t proxy_socket = let path = Printf.sprintf "%s/%s.%d" !unix (Filename.basename Sys.argv.(0)) (Unix.getpid ()) in if Sys.file_exists path then Unix.unlink path; - Lwt_unix.bind s_unix (Lwt_unix.ADDR_UNIX path); + Lwt_unix.Versioned.bind_2 s_unix (Lwt_unix.ADDR_UNIX path) >>= fun () -> List.iter (fun signal -> ignore(Lwt_unix.on_signal signal (fun _ -> Unix.unlink path; exit 1)) ) [ Sys.sigterm; Sys.sigint ]; diff --git a/xcp.opam b/xcp.opam index d51c74d5..758e12ec 100644 --- a/xcp.opam +++ b/xcp.opam @@ -24,7 +24,7 @@ depends: [ "xapi-inventory" "xapi-backtrace" "fd-send-recv" - "lwt" {< "3.0.0"} + "lwt" {< "3.0.0" & >= "2.7.1"} "ounit" {>= "2.0.0"} "ppx_sexp_conv" "sexplib" From d28be23689dbde5c20853aac0cab3b57ebdbc98a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:39:48 +0100 Subject: [PATCH 11/20] jbuilder --dev: fix ambiguos doc comment MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- lib/debug.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/debug.ml b/lib/debug.ml index 85402d06..2322cbdd 100644 --- a/lib/debug.ml +++ b/lib/debug.ml @@ -15,6 +15,7 @@ module Mutex = struct include Mutex + (** execute the function f with the mutex hold *) let execute lock f = Mutex.lock lock; From d9c3009f77e7601c3c8f0b23c92985526844a141 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:39:51 +0100 Subject: [PATCH 12/20] jbuilder: xapi-idl vs xcp MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Slight problem with how ocamlfind libraries are all called xcp, but the opam package is xapi-idl. Jbuilder expects the two of them to match though. Signed-off-by: Edwin Török --- .travis.yml | 1 + xapi-idl.opam | 8 ++++++++ 2 files changed, 9 insertions(+) create mode 100644 xapi-idl.opam diff --git a/.travis.yml b/.travis.yml index 4a3d66a9..6c3fc2b6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -11,6 +11,7 @@ services: env: global: - OCAML_VERSION=4.04.2 + - PINS="xcp:." - PACKAGE=xapi-idl - DISTRO="debian-unstable" matrix: diff --git a/xapi-idl.opam b/xapi-idl.opam new file mode 100644 index 00000000..1034ebdc --- /dev/null +++ b/xapi-idl.opam @@ -0,0 +1,8 @@ +opam-version: "1.2" +authors: "Dave Scott" +homepage: "https://github.com/xapi-project/xcp-idl" +bug-reports: "https://github.com/xapi-project/xcp-idl/issues" +dev-repo: "git://github.com/xapi-project/xcp-idl" +maintainer: "xen-api@lists.xen.org" +tags: [ "org:xapi-project" ] +depends: [ "xcp" ] From 9fad1155012d5576f0569da3e49e31116f26361e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:39:54 +0100 Subject: [PATCH 13/20] Add .coverage.sh MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Based on xapi-project/nbd#bugfix-v2.x Signed-off-by: Edwin Török --- .coverage.sh | 31 +++++++++++++++++++++++++++++++ .travis.yml | 5 ++--- 2 files changed, 33 insertions(+), 3 deletions(-) create mode 100644 .coverage.sh diff --git a/.coverage.sh b/.coverage.sh new file mode 100644 index 00000000..36f85a4a --- /dev/null +++ b/.coverage.sh @@ -0,0 +1,31 @@ +#!/bin/sh + +set -ex + +COVERAGE_DIR=.coverage +rm -rf $COVERAGE_DIR +mkdir -p $COVERAGE_DIR +pushd $COVERAGE_DIR +if [ -z "$KEEP" ]; then trap "popd; rm -rf $COVERAGE_DIR" EXIT; fi + +$(which cp) -r ../* . + +opam pin add bisect_ppx 1.3.0 -y +opam install ocveralls -y + +export BISECT_ENABLE=YES +jbuilder runtest + +outs=$(find . | grep bisect.*.out) +bisect-ppx-report -I $(dirname $outs[1]) -text report $outs +bisect-ppx-report -I $(dirname $outs[1]) -summary-only -text summary $outs +if [ -n "$HTML" ]; then bisect-ppx-report -I $(dirname $outs[1]) -html ../html-report $outs; fi + +if [ -n "$TRAVIS" ]; then + echo "\$TRAVIS set; running ocveralls and sending to coveralls.io..." + ocveralls --prefix _build/default $outs --send +else + echo "\$TRAVIS not set; displaying results of bisect-report..." + cat report + cat summary +fi diff --git a/.travis.yml b/.travis.yml index 6c3fc2b6..f7c1a3b7 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,10 +1,8 @@ language: c install: - wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-docker.sh - - wget https://raw.githubusercontent.com/simonjbeaumont/ocaml-travis-coveralls/master/travis-coveralls.sh script: - bash -ex .travis-docker.sh - - if [ ! -z "${XS_COV}" ]; then bash -ex travis-coveralls.sh || true; fi sudo: required services: - docker @@ -15,7 +13,8 @@ env: - PACKAGE=xapi-idl - DISTRO="debian-unstable" matrix: - - BASE_REMOTE=git://github.com/xapi-project/xs-opam XS_COV=1 COV_CONF="ocaml setup.ml -configure --enable-tests" + - BASE_REMOTE=git://github.com/xapi-project/xs-opam \ + POST_INSTALL_HOOK="env TRAVIS=$TRAVIS TRAVIS_JOB_ID=$TRAVIS_JOB_ID bash -ex .coverage.sh" - EXTRA_REMOTES=git://github.com/xapi-project/xs-opam matrix: fast_finish: true From ad4c13526d7ccf97fcc2dc9e13e7ccb5893c2cca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:39:58 +0100 Subject: [PATCH 14/20] Add bisect_ppx preprocessing MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- .coverage.sh | 3 +-- example/jbuild | 12 ++++++++++-- lib/jbuild | 17 ++++++++++++++--- lib_test/jbuild | 12 ++++++++++-- memory/jbuild | 12 ++++++++++-- network/jbuild | 15 ++++++++++++--- rrd/jbuild | 18 ++++++++++++++---- storage/jbuild | 21 ++++++++++++++++----- v6/jbuild | 15 ++++++++++++--- xen/jbuild | 21 +++++++++++++++++---- 10 files changed, 116 insertions(+), 30 deletions(-) diff --git a/.coverage.sh b/.coverage.sh index 36f85a4a..fbcda469 100644 --- a/.coverage.sh +++ b/.coverage.sh @@ -10,8 +10,7 @@ if [ -z "$KEEP" ]; then trap "popd; rm -rf $COVERAGE_DIR" EXIT; fi $(which cp) -r ../* . -opam pin add bisect_ppx 1.3.0 -y -opam install ocveralls -y +opam install bisect_ppx ocveralls -y export BISECT_ENABLE=YES jbuilder runtest diff --git a/example/jbuild b/example/jbuild index 6c0f0e09..a576578e 100644 --- a/example/jbuild +++ b/example/jbuild @@ -18,16 +18,24 @@ let flags = function let rewriters = ["ppx_deriving_rpc"] let flags = flags rewriters +let coverage_rewriter = + let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in + if is_coverage then + "(preprocess (pps (bisect_ppx -conditional)))" + else + "" + let () = Printf.ksprintf Jbuild_plugin.V1.send {| (jbuild_version 1) (executable ((name example) (flags (:standard -w -39 %s)) - (libraries (lwt lwt.unix xcp rpclib)))) + (libraries (lwt lwt.unix xcp rpclib)) + %s)) (alias ((name runtest) (deps (example.exe)) )) -|} flags +|} flags coverage_rewriter diff --git a/lib/jbuild b/lib/jbuild index ea816870..d4881bd0 100644 --- a/lib/jbuild +++ b/lib/jbuild @@ -15,6 +15,13 @@ let flags = function in go ic "" +let coverage_rewriter = + let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in + if is_coverage then + "(preprocess (pps (bisect_ppx -conditional)))" + else + "" + let rewriters = ["ppx_deriving_rpc"] let flags = flags rewriters @@ -30,7 +37,9 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (libraries (cmdliner uri re cohttp xmlm unix sexplib ppx_deriving_rpc rpclib rpclib.xml threads message_switch.unix fd-send-recv xcp-inventory xapi-backtrace)) - (wrapped false))) + (wrapped false) + %s +)) (library ((name xcp_updates) @@ -38,7 +47,9 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (flags (:standard -w -39 %s)) (modules (updates task_server scheduler)) (libraries (xcp lwt)) - (wrapped false))) + (wrapped false) + %s +)) (executable ((name channel_helper) @@ -50,4 +61,4 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| ((name runtest) (deps (channel_helper.exe)))) -|} flags flags flags +|} flags coverage_rewriter flags coverage_rewriter flags diff --git a/lib_test/jbuild b/lib_test/jbuild index 26e3234a..a88cdfb3 100644 --- a/lib_test/jbuild +++ b/lib_test/jbuild @@ -18,17 +18,25 @@ let flags = function let rewriters = ["ppx_deriving_rpc"; "ppx_sexp_conv"] let flags = flags rewriters +let coverage_rewriter = + let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in + if is_coverage then + "(preprocess (pps (bisect_ppx -conditional)))" + else + "" + let () = Printf.ksprintf Jbuild_plugin.V1.send {| (jbuild_version 1) (executable ((name test) (flags (:standard -w -39 %s)) - (libraries (lwt lwt.unix xcp xcp.xen threads rpclib oUnit xcp.updates)))) + (libraries (lwt lwt.unix xcp xcp.xen threads rpclib oUnit xcp.updates)) + %s)) (alias ((name runtest) (deps (test.exe)) (action (run ${<} -runner sequential)))) -|} flags +|} flags coverage_rewriter diff --git a/memory/jbuild b/memory/jbuild index 96099a6a..263c8f5b 100644 --- a/memory/jbuild +++ b/memory/jbuild @@ -18,6 +18,13 @@ let flags = function let rewriters = ["ppx_deriving_rpc"] let flags = flags rewriters +let coverage_rewriter = + let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in + if is_coverage then + "(preprocess (pps (bisect_ppx -conditional)))" + else + "" + let () = Printf.ksprintf Jbuild_plugin.V1.send {| (jbuild_version 1) @@ -27,7 +34,8 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (flags (:standard -w -39 %s)) (modules (:standard \ memory_cli)) (libraries (xcp threads rpclib)) - (wrapped false))) + (wrapped false) + %s)) (executable ((name memory_cli) @@ -38,4 +46,4 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| ((name runtest) (deps (memory_cli.exe)))) -|} flags +|} flags coverage_rewriter diff --git a/network/jbuild b/network/jbuild index b28e7f99..73373cfc 100644 --- a/network/jbuild +++ b/network/jbuild @@ -15,6 +15,13 @@ let flags = function in go ic "" +let coverage_rewriter = + let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in + if is_coverage then + "(preprocess (pps (bisect_ppx -conditional)))" + else + "" + let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"] let rewriters_ppx = ["ppx_deriving_rpc"; "ppx_sexp_conv"] @@ -27,7 +34,8 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (modules (network_interface)) (flags (:standard -w -39 %s)) (libraries (xcp threads rpclib)) - (wrapped false))) + (wrapped false) + %s)) (library ((name xcp_network) @@ -35,6 +43,7 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (modules (:standard \ network_interface)) (flags (:standard -w -39-33 %s)) (libraries (xcp threads rpclib xcp_network_interface)) - (wrapped false))) + (wrapped false) + %s)) -|} (flags rewriters_camlp4) (flags rewriters_ppx) +|} (flags rewriters_camlp4) coverage_rewriter (flags rewriters_ppx) coverage_rewriter diff --git a/rrd/jbuild b/rrd/jbuild index 8da662d0..ec3aa22e 100644 --- a/rrd/jbuild +++ b/rrd/jbuild @@ -18,6 +18,13 @@ let flags = function let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"] let rewriters_ppx = ["ppx_deriving_rpc"] +let coverage_rewriter = + let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in + if is_coverage then + "(preprocess (pps (bisect_ppx -conditional)))" + else + "" + let () = Printf.ksprintf Jbuild_plugin.V1.send {| (jbuild_version 1) @@ -27,7 +34,8 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (modules (data_source)) (flags (:standard -w -39 %s)) (libraries (xcp threads rpclib rrd)) - (wrapped false))) + (wrapped false) + %s)) (library ((name xcp_rrd_interface) @@ -35,7 +43,8 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (modules (rrd_interface)) (flags (:standard -w -39 %s)) (libraries (xcp threads rpclib rrd xcp_rrd_interface_types)) - (wrapped false))) + (wrapped false) + %s)) (library ((name xcp_rrd) @@ -43,5 +52,6 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (modules (:standard \ rrd_interface data_source)) (flags (:standard -w -39 %s)) (libraries (xcp threads rpclib rrd xcp_rrd_interface)) - (wrapped false))) -|} (flags rewriters_ppx) (flags rewriters_camlp4) (flags rewriters_ppx) + (wrapped false) + %s)) +|} (flags rewriters_ppx) coverage_rewriter (flags rewriters_camlp4) coverage_rewriter (flags rewriters_ppx) coverage_rewriter diff --git a/storage/jbuild b/storage/jbuild index aa13554f..fd325403 100644 --- a/storage/jbuild +++ b/storage/jbuild @@ -15,6 +15,13 @@ let flags = function in go ic "" +let coverage_rewriter = + let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in + if is_coverage then + "(preprocess (pps (bisect_ppx -conditional)))" + else + "" + let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"] let rewriters_ppx = ["ppx_deriving_rpc"; "ppx_sexp_conv"] @@ -27,7 +34,8 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (flags (:standard -w -39 %s)) (modules (vdi_automaton)) (libraries (xcp threads rpclib)) - (wrapped false))) + (wrapped false) + %s)) (library ((name xcp_storage_interface) @@ -35,7 +43,8 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (flags (:standard -w -39 %s)) (modules (storage_interface)) (libraries (xcp threads rpclib xcp_storage_interface_types)) - (wrapped false))) + (wrapped false) + %s)) (library ((name xcp_storage) @@ -43,12 +52,14 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (flags (:standard -w -39 %s)) (modules (:standard \ storage_test storage_interface vdi_automaton)) (libraries (xcp threads rpclib xcp_storage_interface xcp_storage_interface_types)) - (wrapped false))) + (wrapped false) + %s)) (executable ((name storage_test) (flags (:standard -w -39 %s)) (modules (storage_test)) - (libraries (xcp xcp_storage oUnit cmdliner)))) + (libraries (xcp xcp_storage oUnit cmdliner)) + %s)) -|} (flags rewriters_ppx) (flags rewriters_camlp4) (flags rewriters_ppx) (flags rewriters_ppx) +|} (flags rewriters_ppx) coverage_rewriter (flags rewriters_camlp4) coverage_rewriter (flags rewriters_ppx) coverage_rewriter (flags rewriters_ppx) coverage_rewriter diff --git a/v6/jbuild b/v6/jbuild index cce78738..03d346e3 100644 --- a/v6/jbuild +++ b/v6/jbuild @@ -18,6 +18,13 @@ let flags = function let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"] let rewriters_ppx = ["ppx_deriving_rpc"; "ppx_sexp_conv"] +let coverage_rewriter = + let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in + if is_coverage then + "(preprocess (pps (bisect_ppx -conditional)))" + else + "" + let () = Printf.ksprintf Jbuild_plugin.V1.send {| (jbuild_version 1) @@ -27,7 +34,8 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (modules (v6_interface)) (flags (:standard -w -39 %s)) (libraries (xcp threads rpclib)) - (wrapped false))) + (wrapped false) + %s)) (library ((name xapi_v6) @@ -35,6 +43,7 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (modules (:standard \ v6_interface)) (flags (:standard -w -39 %s)) (libraries (xcp threads rpclib xapi_v6_interface)) - (wrapped false))) + (wrapped false) + %s)) -|} (flags rewriters_camlp4) (flags rewriters_ppx) +|} (flags rewriters_camlp4) coverage_rewriter (flags rewriters_ppx) coverage_rewriter diff --git a/xen/jbuild b/xen/jbuild index 826e0e2d..91c13c99 100644 --- a/xen/jbuild +++ b/xen/jbuild @@ -18,6 +18,14 @@ let flags = function let rewriters_ppx = ["ppx_deriving_rpc"; "ppx_sexp_conv"] let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"] +let coverage_rewriter = "" +(* (preprocess (pps)) doesn't work with camlp4 and the other ppx derivers, + it complains about missing rpc_of_t *) +let rewriters_ppx = + let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in + if is_coverage then "bisect_ppx" :: rewriters_ppx else rewriters_ppx + + let () = Printf.ksprintf Jbuild_plugin.V1.send {| (jbuild_version 1) @@ -27,19 +35,24 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (modules (xenops_types device_number)) (flags (:standard -w -39 %s)) (libraries (xcp threads rpclib)) - (wrapped false))) + (wrapped false) + %s)) + (library ((name xcp_xen_interface) (public_name xcp.xen.interface) (modules (xenops_interface)) (flags (:standard -w -39 %s)) (libraries (xcp threads rpclib xcp_xen_interface_types)) - (wrapped false))) + (wrapped false) + %s)) + (library ((name xcp_xen) (public_name xcp.xen) (modules (:standard \ xenops_interface xenops_types device_number)) (flags (:standard -w -39 %s)) (libraries (xcp threads rpclib xcp_xen_interface)) - (wrapped false))) -|} (flags rewriters_ppx) (flags rewriters_camlp4) (flags rewriters_ppx) + (wrapped false) + %s)) +|} (flags rewriters_ppx) coverage_rewriter (flags rewriters_camlp4) coverage_rewriter (flags rewriters_ppx) coverage_rewriter From 254f58ea0e892604ae5b385864c183304f64fee2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 29 Sep 2017 17:40:04 +0100 Subject: [PATCH 15/20] Disable deprecation warning on String.lowercase MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This should be replaced by String.lowercase_ascii, but that wouldn't compile with 4.02.3 anymore. Asking everyone to upgrade to 4.04.2 might be too early for now. Signed-off-by: Edwin Török --- lib/syslog.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/syslog.ml b/lib/syslog.ml index b176cd2d..c8ae9960 100644 --- a/lib/syslog.ml +++ b/lib/syslog.ml @@ -49,7 +49,7 @@ let facility_of_string s = exception Unknown_level of string let level_of_string s = - match String.lowercase s with + match (String.lowercase s)[@ocaml.warning "-3"] with | "emergency" -> Emerg | "alert" -> Alert | "critical" -> Crit From 75d2189dcc7512f6de6d9a75eccf03df4ec797e5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Mon, 2 Oct 2017 13:32:34 +0100 Subject: [PATCH 16/20] fixup! Disable deprecation warning on String.lowercase MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Instead of silencing the deprecation warning completely just make the warning non-fatal, even when jbuilder --dev is used. Signed-off-by: Edwin Török --- lib/jbuild | 2 +- lib/syslog.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/jbuild b/lib/jbuild index d4881bd0..d964bfbb 100644 --- a/lib/jbuild +++ b/lib/jbuild @@ -31,7 +31,7 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (library ((name xcp) (public_name xcp) - (flags (:standard -w -39 %s)) + (flags (:standard -w -39 %s -warn-error -3)) (modules (:standard \ updates task_server scheduler channel_helper)) (c_names (syslog_stubs)) (libraries (cmdliner uri re cohttp xmlm unix sexplib diff --git a/lib/syslog.ml b/lib/syslog.ml index c8ae9960..b176cd2d 100644 --- a/lib/syslog.ml +++ b/lib/syslog.ml @@ -49,7 +49,7 @@ let facility_of_string s = exception Unknown_level of string let level_of_string s = - match (String.lowercase s)[@ocaml.warning "-3"] with + match String.lowercase s with | "emergency" -> Emerg | "alert" -> Alert | "critical" -> Crit From f231e9bbecf1a5ac9ee54a95b53bf8a7d46faa33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Mon, 2 Oct 2017 13:35:33 +0100 Subject: [PATCH 17/20] drop unused D module MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- example/example.ml | 1 - lib/updates.ml | 2 -- 2 files changed, 3 deletions(-) diff --git a/example/example.ml b/example/example.ml index 68144504..92b83350 100644 --- a/example/example.ml +++ b/example/example.ml @@ -13,7 +13,6 @@ *) open Xcp_service -module D = Debug.Make(struct let name = "example" end) let ls = ref "/bin/ls" let sh = ref "/bin/sh" diff --git a/lib/updates.ml b/lib/updates.ml index 76dfcd6e..79f06990 100644 --- a/lib/updates.ml +++ b/lib/updates.ml @@ -4,8 +4,6 @@ open Stdext open Pervasiveext -module D = Debug.Make(struct let name = "updates" end) - module type INTERFACE = sig val service_name : string From 933d51461c986dbdab75073aa141827e115aaebc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 3 Oct 2017 09:30:01 +0100 Subject: [PATCH 18/20] Reformat jbuild files MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Use sorted columnar format for dependencies. Reindent jbuild files Signed-off-by: Edwin Török --- example/jbuild | 35 +++++++++++++++------------- lib/jbuild | 62 +++++++++++++++++++++++++++++++------------------ lib_test/jbuild | 35 +++++++++++++++++----------- memory/jbuild | 38 +++++++++++++++++------------- network/jbuild | 35 +++++++++++++++++----------- rrd/jbuild | 46 +++++++++++++++++++++++------------- storage/jbuild | 59 ++++++++++++++++++++++++++++------------------ v6/jbuild | 36 ++++++++++++++++------------ xen/jbuild | 45 +++++++++++++++++++++-------------- 9 files changed, 238 insertions(+), 153 deletions(-) diff --git a/example/jbuild b/example/jbuild index a576578e..95e086f1 100644 --- a/example/jbuild +++ b/example/jbuild @@ -2,18 +2,18 @@ #require "unix" let flags = function -| [] -> "" -| pkgs -> - let cmd = "ocamlfind ocamlc -verbose" ^ ( - List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs - ) in - let ic = Unix.open_process_in - (cmd ^ " | grep -oEe '-ppx (\"([^\"\\]|\\.)+\"|\\w+)'") - in - let rec go ic acc = - try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc - in - go ic "" + | [] -> "" + | pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" let rewriters = ["ppx_deriving_rpc"] let flags = flags rewriters @@ -31,11 +31,14 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (executable ((name example) (flags (:standard -w -39 %s)) - (libraries (lwt lwt.unix xcp rpclib)) + (libraries + (lwt + lwt.unix + rpclib + xcp)) %s)) (alias - ((name runtest) - (deps (example.exe)) - )) + ((name runtest) + (deps (example.exe)))) |} flags coverage_rewriter diff --git a/lib/jbuild b/lib/jbuild index d964bfbb..5578bc76 100644 --- a/lib/jbuild +++ b/lib/jbuild @@ -2,18 +2,18 @@ #require "unix" let flags = function -| [] -> "" -| pkgs -> - let cmd = "ocamlfind ocamlc -verbose" ^ ( - List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs - ) in - let ic = Unix.open_process_in - (cmd ^ " | grep -oEe '-ppx (\"([^\"\\]|\\.)+\"|\\w+)'") - in - let rec go ic acc = - try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc - in - go ic "" + | [] -> "" + | pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" let coverage_rewriter = let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in @@ -32,33 +32,49 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| ((name xcp) (public_name xcp) (flags (:standard -w -39 %s -warn-error -3)) - (modules (:standard \ updates task_server scheduler channel_helper)) + (modules (:standard \ channel_helper scheduler task_server updates)) (c_names (syslog_stubs)) - (libraries (cmdliner uri re cohttp xmlm unix sexplib - ppx_deriving_rpc rpclib rpclib.xml threads message_switch.unix - fd-send-recv xcp-inventory xapi-backtrace)) + (libraries + (cmdliner + cohttp + fd-send-recv + message_switch.unix + ppx_deriving_rpc + re + rpclib + rpclib.xml + sexplib + threads + unix + uri + xapi-backtrace + xcp-inventory + xmlm)) (wrapped false) - %s -)) + %s)) (library ((name xcp_updates) (public_name xcp.updates) (flags (:standard -w -39 %s)) (modules (updates task_server scheduler)) - (libraries (xcp lwt)) + (libraries + (lwt + xcp)) (wrapped false) - %s -)) + %s)) (executable ((name channel_helper) (flags (:standard -w -39 %s)) (modules (channel_helper)) - (libraries (xcp lwt lwt.unix cmdliner)))) + (libraries + (cmdliner + lwt + lwt.unix + xcp)))) (alias ((name runtest) (deps (channel_helper.exe)))) - |} flags coverage_rewriter flags coverage_rewriter flags diff --git a/lib_test/jbuild b/lib_test/jbuild index a88cdfb3..fc78fae1 100644 --- a/lib_test/jbuild +++ b/lib_test/jbuild @@ -2,18 +2,18 @@ #require "unix" let flags = function -| [] -> "" -| pkgs -> - let cmd = "ocamlfind ocamlc -verbose" ^ ( - List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs - ) in - let ic = Unix.open_process_in - (cmd ^ " | grep -oEe '-ppx (\"([^\"\\]|\\.)+\"|\\w+)'") - in - let rec go ic acc = - try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc - in - go ic "" + | [] -> "" + | pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" let rewriters = ["ppx_deriving_rpc"; "ppx_sexp_conv"] let flags = flags rewriters @@ -31,12 +31,19 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (executable ((name test) (flags (:standard -w -39 %s)) - (libraries (lwt lwt.unix xcp xcp.xen threads rpclib oUnit xcp.updates)) + (libraries + (lwt + lwt.unix + oUnit + rpclib + threads + xcp + xcp.updates + xcp.xen)) %s)) (alias ((name runtest) (deps (test.exe)) (action (run ${<} -runner sequential)))) - |} flags coverage_rewriter diff --git a/memory/jbuild b/memory/jbuild index 263c8f5b..281ed47d 100644 --- a/memory/jbuild +++ b/memory/jbuild @@ -2,18 +2,18 @@ #require "unix" let flags = function -| [] -> "" -| pkgs -> - let cmd = "ocamlfind ocamlc -verbose" ^ ( - List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs - ) in - let ic = Unix.open_process_in - (cmd ^ " | grep -oEe '-ppx (\"([^\"\\]|\\.)+\"|\\w+)'") - in - let rec go ic acc = - try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc - in - go ic "" + | [] -> "" + | pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" let rewriters = ["ppx_deriving_rpc"] let flags = flags rewriters @@ -33,17 +33,23 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (public_name xcp.memory) (flags (:standard -w -39 %s)) (modules (:standard \ memory_cli)) - (libraries (xcp threads rpclib)) + (libraries + (rpclib + threads + xcp)) (wrapped false) %s)) (executable ((name memory_cli) - (modules (memory_cli)) - (libraries (xcp.memory cmdliner rpclib.cmdliner rpclib.markdown)))) + (modules (memory_cli)) + (libraries + (cmdliner + rpclib.cmdliner + rpclib.markdown + xcp.memory)))) (alias ((name runtest) (deps (memory_cli.exe)))) - |} flags coverage_rewriter diff --git a/network/jbuild b/network/jbuild index 73373cfc..a506878c 100644 --- a/network/jbuild +++ b/network/jbuild @@ -2,18 +2,18 @@ #require "unix" let flags = function -| [] -> "" -| pkgs -> - let cmd = "ocamlfind ocamlc -verbose" ^ ( - List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs - ) in - let ic = Unix.open_process_in - (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") - in - let rec go ic acc = - try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc - in - go ic "" + | [] -> "" + | pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" let coverage_rewriter = let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in @@ -33,7 +33,10 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (public_name xcp.network.interface) (modules (network_interface)) (flags (:standard -w -39 %s)) - (libraries (xcp threads rpclib)) + (libraries + (rpclib + threads + xcp)) (wrapped false) %s)) @@ -42,7 +45,11 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (public_name xcp.network) (modules (:standard \ network_interface)) (flags (:standard -w -39-33 %s)) - (libraries (xcp threads rpclib xcp_network_interface)) + (libraries + (rpclib + threads + xcp + xcp_network_interface)) (wrapped false) %s)) diff --git a/rrd/jbuild b/rrd/jbuild index ec3aa22e..579b2849 100644 --- a/rrd/jbuild +++ b/rrd/jbuild @@ -2,18 +2,18 @@ #require "unix" let flags = function -| [] -> "" -| pkgs -> - let cmd = "ocamlfind ocamlc -verbose" ^ ( - List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs - ) in - let ic = Unix.open_process_in - (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") - in - let rec go ic acc = - try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc - in - go ic "" + | [] -> "" + | pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"] let rewriters_ppx = ["ppx_deriving_rpc"] @@ -33,7 +33,11 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (public_name xcp.rrd.interface.types) (modules (data_source)) (flags (:standard -w -39 %s)) - (libraries (xcp threads rpclib rrd)) + (libraries + (rpclib + rrd + threads + xcp)) (wrapped false) %s)) @@ -42,16 +46,26 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (public_name xcp.rrd.interface) (modules (rrd_interface)) (flags (:standard -w -39 %s)) - (libraries (xcp threads rpclib rrd xcp_rrd_interface_types)) + (libraries + (rpclib + rrd + threads + xcp + xcp_rrd_interface_types)) (wrapped false) %s)) (library ((name xcp_rrd) (public_name xcp.rrd) - (modules (:standard \ rrd_interface data_source)) + (modules (:standard \ data_source rrd_interface)) (flags (:standard -w -39 %s)) - (libraries (xcp threads rpclib rrd xcp_rrd_interface)) + (libraries + (rpclib + rrd + threads + xcp + xcp_rrd_interface)) (wrapped false) %s)) |} (flags rewriters_ppx) coverage_rewriter (flags rewriters_camlp4) coverage_rewriter (flags rewriters_ppx) coverage_rewriter diff --git a/storage/jbuild b/storage/jbuild index fd325403..8156d1f7 100644 --- a/storage/jbuild +++ b/storage/jbuild @@ -2,18 +2,18 @@ #require "unix" let flags = function -| [] -> "" -| pkgs -> - let cmd = "ocamlfind ocamlc -verbose" ^ ( - List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs - ) in - let ic = Unix.open_process_in - (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") - in - let rec go ic acc = - try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc - in - go ic "" + | [] -> "" + | pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" let coverage_rewriter = let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in @@ -33,7 +33,10 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (public_name xcp.storage.interface.types) (flags (:standard -w -39 %s)) (modules (vdi_automaton)) - (libraries (xcp threads rpclib)) + (libraries + (rpclib + threads + xcp)) (wrapped false) %s)) @@ -42,7 +45,11 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (public_name xcp.storage.interface) (flags (:standard -w -39 %s)) (modules (storage_interface)) - (libraries (xcp threads rpclib xcp_storage_interface_types)) + (libraries + (rpclib + threads + xcp + xcp_storage_interface_types)) (wrapped false) %s)) @@ -50,16 +57,24 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| ((name xcp_storage) (public_name xcp.storage) (flags (:standard -w -39 %s)) - (modules (:standard \ storage_test storage_interface vdi_automaton)) - (libraries (xcp threads rpclib xcp_storage_interface xcp_storage_interface_types)) + (modules (:standard \ storage_interface storage_test vdi_automaton)) + (libraries + (rpclib + threads + xcp + xcp_storage_interface + xcp_storage_interface_types)) (wrapped false) %s)) (executable - ((name storage_test) - (flags (:standard -w -39 %s)) - (modules (storage_test)) - (libraries (xcp xcp_storage oUnit cmdliner)) - %s)) - + ((name storage_test) + (flags (:standard -w -39 %s)) + (modules (storage_test)) + (libraries + (cmdliner + oUnit + xcp + xcp_storage)) + %s)) |} (flags rewriters_ppx) coverage_rewriter (flags rewriters_camlp4) coverage_rewriter (flags rewriters_ppx) coverage_rewriter (flags rewriters_ppx) coverage_rewriter diff --git a/v6/jbuild b/v6/jbuild index 03d346e3..6f2022a1 100644 --- a/v6/jbuild +++ b/v6/jbuild @@ -2,18 +2,18 @@ #require "unix" let flags = function -| [] -> "" -| pkgs -> - let cmd = "ocamlfind ocamlc -verbose" ^ ( - List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs - ) in - let ic = Unix.open_process_in - (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") - in - let rec go ic acc = - try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc - in - go ic "" + | [] -> "" + | pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"] let rewriters_ppx = ["ppx_deriving_rpc"; "ppx_sexp_conv"] @@ -33,7 +33,10 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (public_name xcp.v6.interface) (modules (v6_interface)) (flags (:standard -w -39 %s)) - (libraries (xcp threads rpclib)) + (libraries + (rpclib + threads + xcp)) (wrapped false) %s)) @@ -42,8 +45,11 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (public_name xcp.v6) (modules (:standard \ v6_interface)) (flags (:standard -w -39 %s)) - (libraries (xcp threads rpclib xapi_v6_interface)) + (libraries + (rpclib + threads + xapi_v6_interface + xcp)) (wrapped false) %s)) - |} (flags rewriters_camlp4) coverage_rewriter (flags rewriters_ppx) coverage_rewriter diff --git a/xen/jbuild b/xen/jbuild index 91c13c99..44c42055 100644 --- a/xen/jbuild +++ b/xen/jbuild @@ -2,25 +2,25 @@ #require "unix" let flags = function -| [] -> "" -| pkgs -> - let cmd = "ocamlfind ocamlc -verbose" ^ ( - List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs - ) in - let ic = Unix.open_process_in - (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") - in - let rec go ic acc = - try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc - in - go ic "" + | [] -> "" + | pkgs -> + let cmd = "ocamlfind ocamlc -verbose" ^ ( + List.fold_left (fun acc pkg -> acc ^ " -package " ^ pkg) "" pkgs + ) in + let ic = Unix.open_process_in + (cmd ^ " | grep -oEe '-ppx? (\"([^\"\\]|\\.)+\"|\\w+)'") + in + let rec go ic acc = + try go ic (acc ^ " " ^ input_line ic) with End_of_file -> close_in ic; acc + in + go ic "" let rewriters_ppx = ["ppx_deriving_rpc"; "ppx_sexp_conv"] let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"] let coverage_rewriter = "" (* (preprocess (pps)) doesn't work with camlp4 and the other ppx derivers, - it complains about missing rpc_of_t *) + it complains about missing rpc_of_t *) let rewriters_ppx = let is_coverage = try Unix.getenv "BISECT_ENABLE" = "YES" with Not_found -> false in if is_coverage then "bisect_ppx" :: rewriters_ppx else rewriters_ppx @@ -34,7 +34,10 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (public_name xcp.xen.interface.types) (modules (xenops_types device_number)) (flags (:standard -w -39 %s)) - (libraries (xcp threads rpclib)) + (libraries + (rpclib + threads + xcp)) (wrapped false) %s)) @@ -43,16 +46,24 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (public_name xcp.xen.interface) (modules (xenops_interface)) (flags (:standard -w -39 %s)) - (libraries (xcp threads rpclib xcp_xen_interface_types)) + (libraries + (rpclib + threads + xcp + xcp_xen_interface_types)) (wrapped false) %s)) (library ((name xcp_xen) (public_name xcp.xen) - (modules (:standard \ xenops_interface xenops_types device_number)) + (modules (:standard \ device_number xenops_interface xenops_types)) (flags (:standard -w -39 %s)) - (libraries (xcp threads rpclib xcp_xen_interface)) + (libraries + (rpclib + threads + xcp + xcp_xen_interface)) (wrapped false) %s)) |} (flags rewriters_ppx) coverage_rewriter (flags rewriters_camlp4) coverage_rewriter (flags rewriters_ppx) coverage_rewriter From ebe9f3f63c2225d2562c4e89c866ef2e22b878fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 3 Oct 2017 10:49:52 +0100 Subject: [PATCH 19/20] sort opam dependencies MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- xcp.opam | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/xcp.opam b/xcp.opam index 758e12ec..f23591dd 100644 --- a/xcp.opam +++ b/xcp.opam @@ -8,24 +8,24 @@ tags: [ "org:xapi-project" ] build: [[ "jbuilder" "build" "-p" name "-j" jobs ]] build-test: ["jbuilder" "runtest" "-p" name] depends: [ - "ocamlfind" {build} "jbuilder" {build & >= "1.0+beta11"} + "ocamlfind" {build} "base-threads" "base-unix" - "uri" - "re" "cmdliner" "cohttp" {< "0.22.0"} - "xmlm" - "rpc" {>= "1.9.51"} - "message-switch" - "xapi-stdext" - "xapi-rrd" - "xapi-inventory" - "xapi-backtrace" "fd-send-recv" "lwt" {< "3.0.0" & >= "2.7.1"} + "message-switch" "ounit" {>= "2.0.0"} "ppx_sexp_conv" + "re" + "rpc" {>= "1.9.51"} "sexplib" + "uri" + "xapi-backtrace" + "xapi-inventory" + "xapi-rrd" + "xapi-stdext" + "xmlm" ] From f14bc49ae30f496f3a45cb7c436a5e9c9cf0170b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Tue, 3 Oct 2017 11:10:10 +0100 Subject: [PATCH 20/20] Move from deprecated Stdext to more specific Xapi-stdext-* modules MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Xapi_stdext_monadic is needed for Opt Signed-off-by: Edwin Török --- lib/jbuild | 3 +++ lib/task_server.ml | 6 +++--- lib/updates.ml | 6 +++--- lib/xcp_service.ml | 2 +- storage/jbuild | 1 + storage/storage_interface.ml | 2 +- xcp.opam | 9 ++++++--- 7 files changed, 18 insertions(+), 11 deletions(-) diff --git a/lib/jbuild b/lib/jbuild index 5578bc76..26d65590 100644 --- a/lib/jbuild +++ b/lib/jbuild @@ -48,6 +48,9 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| unix uri xapi-backtrace + xapi-stdext-monadic + xapi-stdext-pervasives + xapi-stdext-threads xcp-inventory xmlm)) (wrapped false) diff --git a/lib/task_server.ml b/lib/task_server.ml index 0a0a639d..06657d37 100644 --- a/lib/task_server.ml +++ b/lib/task_server.ml @@ -14,9 +14,9 @@ (** * @group Xenops *) -open Stdext -open Threadext -open Pervasiveext +open Xapi_stdext_monadic +open Xapi_stdext_pervasives.Pervasiveext +open Xapi_stdext_threads.Threadext module D = Debug.Make(struct let name = "task_server" end) diff --git a/lib/updates.ml b/lib/updates.ml index 79f06990..e17b0d7a 100644 --- a/lib/updates.ml +++ b/lib/updates.ml @@ -1,8 +1,8 @@ (******************************************************************************) (* Object update tracking *) -open Stdext -open Pervasiveext +open Xapi_stdext_monadic +open Xapi_stdext_pervasives.Pervasiveext module type INTERFACE = sig val service_name : string @@ -111,7 +111,7 @@ module Updates = functor(Interface : INTERFACE) -> struct (* let fold f t init = M.fold f t.map init *) end - open Stdext.Threadext + open Xapi_stdext_threads.Threadext module U = UpdateRecorder(struct type t = Interface.Dynamic.id let compare = compare end) diff --git a/lib/xcp_service.ml b/lib/xcp_service.ml index 5999292e..2027956c 100644 --- a/lib/xcp_service.ml +++ b/lib/xcp_service.ml @@ -11,7 +11,7 @@ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. *) -open Stdext +open Xapi_stdext_monadic module StringSet = Set.Make(String) (* Server configuration. We have built-in (hopefully) sensible defaults, diff --git a/storage/jbuild b/storage/jbuild index 8156d1f7..eac21c87 100644 --- a/storage/jbuild +++ b/storage/jbuild @@ -61,6 +61,7 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {| (libraries (rpclib threads + xapi-stdext-date xcp xcp_storage_interface xcp_storage_interface_types)) diff --git a/storage/storage_interface.ml b/storage/storage_interface.ml index 627e061e..b9e20aea 100644 --- a/storage/storage_interface.ml +++ b/storage/storage_interface.ml @@ -80,7 +80,7 @@ let default_vdi_info = { ty = "user"; metadata_of_pool = ""; is_a_snapshot = false; - snapshot_time = Stdext.Date.to_string Stdext.Date.never; + snapshot_time = Xapi_stdext_date.Date.to_string Xapi_stdext_date.Date.never; snapshot_of = ""; read_only = false; virtual_size = 0L; diff --git a/xcp.opam b/xcp.opam index f23591dd..5e9b8454 100644 --- a/xcp.opam +++ b/xcp.opam @@ -8,15 +8,15 @@ tags: [ "org:xapi-project" ] build: [[ "jbuilder" "build" "-p" name "-j" jobs ]] build-test: ["jbuilder" "runtest" "-p" name] depends: [ - "jbuilder" {build & >= "1.0+beta11"} - "ocamlfind" {build} "base-threads" "base-unix" "cmdliner" "cohttp" {< "0.22.0"} "fd-send-recv" + "jbuilder" {build & >= "1.0+beta11"} "lwt" {< "3.0.0" & >= "2.7.1"} "message-switch" + "ocamlfind" {build} "ounit" {>= "2.0.0"} "ppx_sexp_conv" "re" @@ -26,6 +26,9 @@ depends: [ "xapi-backtrace" "xapi-inventory" "xapi-rrd" - "xapi-stdext" + "xapi-stdext-date" + "xapi-stdext-monadic" + "xapi-stdext-pervasives" + "xapi-stdext-threads" "xmlm" ]