libxl: ocaml: implement some simple tests

Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>

diff --git a/.gitignore b/.gitignore
index 20f20ed69799fb878e167a6b6eab1137de0f3568..ce5fd39d2ef2d82d94a397ac5b76658349b2eded 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -386,7 +386,8 @@ tools/ocaml/libs/xentoollog/xentoollog.ml
 tools/ocaml/libs/xentoollog/xentoollog.mli
 tools/ocaml/xenstored/oxenstored
 tools/ocaml/test/xtl
-
+tools/ocaml/test/send_debug_keys
+tools/ocaml/test/list_domains
 tools/debugger/kdd/kdd
 tools/firmware/etherboot/ipxe.tar.gz
 tools/firmware/etherboot/ipxe/

diff --git a/.hgignore b/.hgignore
index bb1b67d9d5b20490ee2d85ebd5d161c5cb1e6619..ee5c084d7d66371f2b60d8baeb5a177a86df5a29 100644 (file)
--- a/.hgignore
+++ b/.hgignore
@@ -309,6 +309,8 @@
 ^tools/ocaml/libs/xl/xenlight\.mli$
 ^tools/ocaml/xenstored/oxenstored$
 ^tools/ocaml/test/xtl$
+^tools/ocaml/test/send_debug_keys$
+^tools/ocaml/test/list_domains$
 ^tools/autom4te\.cache$
 ^tools/config\.h$
 ^tools/config\.log$

diff --git a/tools/ocaml/test/Makefile b/tools/ocaml/test/Makefile
index 3a35d04d48cb2c862e9d3b695395f701540c9d54..dfa643750b8a92e0435af97b0b4effc70d925a07 100644 (file)
--- a/tools/ocaml/test/Makefile
+++ b/tools/ocaml/test/Makefile
@@ -2,12 +2,16 @@ XEN_ROOT = $(CURDIR)/../../..
 OCAML_TOPLEVEL = $(CURDIR)/..
 include $(OCAML_TOPLEVEL)/common.make
 
+CFLAGS += $(CFLAGS_libxenlight)
+LIBS_xenlight = $(LDLIBS_libxenlight)
+
 OCAMLINCLUDE += \
-       -I $(OCAML_TOPLEVEL)/libs/xentoollog
+       -I $(OCAML_TOPLEVEL)/libs/xentoollog \
+       -I $(OCAML_TOPLEVEL)/libs/xl
 
-OBJS = xtl
+OBJS = xtl send_debug_keys list_domains raise_exception
 
-PROGRAMS = xtl
+PROGRAMS = xtl send_debug_keys list_domains raise_exception
 
 xtl_LIBS =  \
        -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
@@ -15,7 +19,25 @@ xtl_LIBS =  \
 
 xtl_OBJS = xtl
 
-OCAML_PROGRAM = xtl
+send_debug_keys_LIBS =  \
+       -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
+       -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenlight.cmxa
+
+send_debug_keys_OBJS = xtl send_debug_keys
+
+list_domains_LIBS =  \
+       -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
+       -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenlight.cmxa
+
+list_domains_OBJS = xtl list_domains
+
+raise_exception_LIBS =  \
+       -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
+       -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenlight.cmxa
+
+raise_exception_OBJS = raise_exception
+
+OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception
 
 all: $(PROGRAMS)
 

diff --git a/tools/ocaml/test/list_domains.ml b/tools/ocaml/test/list_domains.ml
new file mode 100644 (file)
index 0000000..c82d40d
--- /dev/null
+++ b/tools/ocaml/test/list_domains.ml
@@ -0,0 +1,28 @@
+open Arg
+open Printf
+open Xenlight
+
+let bool_as_char b c = if b then c else '-'
+
+let print_dominfo dominfo =
+  let id = dominfo.Xenlight.Dominfo.domid
+  and running = bool_as_char dominfo.Xenlight.Dominfo.running 'r'
+  and blocked = bool_as_char dominfo.Xenlight.Dominfo.blocked 'b'
+  and paused = bool_as_char dominfo.Xenlight.Dominfo.paused 'p'
+  and shutdown = bool_as_char dominfo.Xenlight.Dominfo.shutdown 's'
+  and dying = bool_as_char dominfo.Xenlight.Dominfo.dying 'd'
+  and memory = dominfo.Xenlight.Dominfo.current_memkb
+  in
+  printf "Dom %d: %c%c%c%c%c %LdKB\n" id running blocked paused shutdown dying memory
+
+let _ =
+  let logger = Xtl.create_stdio_logger (*~level:Xentoollog.Debug*) () in
+  let ctx = Xenlight.ctx_alloc logger in
+  try
+    let domains = Xenlight.Dominfo.list ctx in
+    List.iter (fun d -> print_dominfo d) domains
+  with Xenlight.Error(err, fn) -> begin
+    printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err) fn;
+  end
+
+

diff --git a/tools/ocaml/test/raise_exception.ml b/tools/ocaml/test/raise_exception.ml
new file mode 100644 (file)
index 0000000..f048a46
--- /dev/null
+++ b/tools/ocaml/test/raise_exception.ml
@@ -0,0 +1,11 @@
+open Printf
+open Xentoollog
+open Xenlight
+
+let _ =
+  try
+    Xenlight.test_raise_exception ()
+  with Xenlight.Error(err, fn) -> begin
+    printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err) fn;
+  end
+

diff --git a/tools/ocaml/test/send_debug_keys.ml b/tools/ocaml/test/send_debug_keys.ml
new file mode 100644 (file)
index 0000000..5900cf9
--- /dev/null
+++ b/tools/ocaml/test/send_debug_keys.ml
@@ -0,0 +1,15 @@
+open Arg
+open Printf
+open Xenlight
+
+let send_keys ctx s =
+  printf "Sending debug key %s\n" s;
+  Xenlight.send_debug_keys ctx s;
+  ()
+  
+let _ =
+  let logger = Xtl.create_stdio_logger () in
+  let ctx = Xenlight.ctx_alloc logger in
+  Arg.parse [
+  ] (fun s -> send_keys ctx s) "usage: send_debug_keys <keys>"
+