Richard W.M. Jones
2021-Dec-11 13:41 UTC
[Libguestfs] [PATCH libnbd 2/2] ocaml: Add NBD.with_handle utility function
NBD.with_handle (fun nbd -> ...)
calls the inner function with a newly created handle, and ensures that
NBD.close is always called even if the inner function throws an
exception.
This is inspired by Laszlo Ersek's similar function added to virt-v2v
lib/utils.ml in the commit below. Unlike that, this does not abstract
the connection and does not call NBD.shutdown.
https://github.com/libguestfs/virt-v2v/commit/b4a8ccf00f1364d703c6d5cf1fd77850105fdd65
I adjusted one example and a few of the tests to use this function.
It is not really necessary to use it, so having a mix of both styles
seems reasonable.
---
generator/OCaml.ml | 15 +++++
ocaml/examples/extents.ml | 66 ++++++++++----------
ocaml/libnbd-ocaml.pod | 15 +++++
ocaml/tests/Makefile.am | 3 +
ocaml/tests/test_105_with_handle.ml | 37 ++++++++++++
ocaml/tests/test_110_defaults.ml | 28 +++++----
ocaml/tests/test_120_set_non_defaults.ml | 76 ++++++++++++------------
ocaml/tests/test_200_connect_command.ml | 9 ++-
ocaml/tests/test_400_pread.ml | 16 +++--
9 files changed, 174 insertions(+), 91 deletions(-)
diff --git a/generator/OCaml.ml b/generator/OCaml.ml
index 1349609bd..4e901648a 100644
--- a/generator/OCaml.ml
+++ b/generator/OCaml.ml
@@ -225,6 +225,17 @@ val close : t -> unit
immediately.
*)
+val with_handle : (t -> 'a) -> 'a
+(** Wrapper around {!create}. It calls the function parameter with a
+ newly created handle, and ensures that {!close} is always called
+ even if the function throws an exception.
+
+ Use this when it is essential that the handle is closed in order
+ to free up external resources in a timely manner; for example if
+ running the server as a subprocess and you want to ensure that the
+ subprocess is always killed; or if you need to disconnect from the
+ server before continuing with another operation. *)
+
";
List.iter (
@@ -315,6 +326,10 @@ type t
external create : unit -> t = \"nbd_internal_ocaml_nbd_create\"
external close : t -> unit = \"nbd_internal_ocaml_nbd_close\"
+let with_handle f + let nbd = create () in
+ try let r = f nbd in close nbd; r with exn -> close nbd; raise exn
+
";
List.iter (
diff --git a/ocaml/examples/extents.ml b/ocaml/examples/extents.ml
index e4422b270..58b4d56cb 100644
--- a/ocaml/examples/extents.ml
+++ b/ocaml/examples/extents.ml
@@ -1,36 +1,38 @@
open Printf
let () - let nbd = NBD.create () in
- NBD.add_meta_context nbd "base:allocation";
- NBD.connect_command nbd
- ["nbdkit"; "-s";
"--exit-with-parent"; "-r";
- "sparse-random"; "8G"];
+ NBD.with_handle (
+ fun nbd ->
+ NBD.add_meta_context nbd "base:allocation";
+ NBD.connect_command nbd
+ ["nbdkit"; "-s";
"--exit-with-parent"; "-r";
+ "sparse-random"; "8G"];
- (* Read the extents and print them. *)
- let size = NBD.get_size nbd in
- let fetch_offset = ref 0_L in
- while !fetch_offset < size do
- let remaining = Int64.sub size !fetch_offset in
- let fetch_size = min remaining 0x8000_0000_L in
- NBD.block_status nbd fetch_size !fetch_offset (
- fun meta _ entries err ->
- printf "nbd_block_status callback: meta=%s err=%d\n" meta
!err;
- if meta = "base:allocation" then (
- printf "index\t%-20s %-20s %s\n" "offset"
"length" "flags";
- for i = 0 to Array.length entries / 2 - 1 do
- let len = Int64.of_int32 entries.(i*2)
- and flags - match entries.(i*2+1) with
- | 0_l -> "data"
- | 1_l -> "hole"
- | 2_l -> "zero"
- | 3_l -> "hole+zero"
- | i -> sprintf "unknown (%ld)" i in
- printf "%d:\t%-20Ld %-20Ld %s\n" i !fetch_offset len
flags;
- fetch_offset := Int64.add !fetch_offset len
- done;
- );
- 0
- ) (* NBD.block_status *)
- done
+ (* Read the extents and print them. *)
+ let size = NBD.get_size nbd in
+ let fetch_offset = ref 0_L in
+ while !fetch_offset < size do
+ let remaining = Int64.sub size !fetch_offset in
+ let fetch_size = min remaining 0x8000_0000_L in
+ NBD.block_status nbd fetch_size !fetch_offset (
+ fun meta _ entries err ->
+ printf "nbd_block_status callback: meta=%s err=%d\n" meta
!err;
+ if meta = "base:allocation" then (
+ printf "index\t%-20s %-20s %s\n" "offset"
"length" "flags";
+ for i = 0 to Array.length entries / 2 - 1 do
+ let len = Int64.of_int32 entries.(i*2)
+ and flags + match entries.(i*2+1) with
+ | 0_l -> "data"
+ | 1_l -> "hole"
+ | 2_l -> "zero"
+ | 3_l -> "hole+zero"
+ | i -> sprintf "unknown (%ld)" i in
+ printf "%d:\t%-20Ld %-20Ld %s\n" i !fetch_offset len
flags;
+ fetch_offset := Int64.add !fetch_offset len
+ done;
+ );
+ 0
+ ) (* NBD.block_status *)
+ done
+ )
diff --git a/ocaml/libnbd-ocaml.pod b/ocaml/libnbd-ocaml.pod
index 19825805b..ebcce37cf 100644
--- a/ocaml/libnbd-ocaml.pod
+++ b/ocaml/libnbd-ocaml.pod
@@ -7,6 +7,18 @@ libnbd-ocaml - how to use libnbd from OCaml
let nbd = NBD.create () in
NBD.connect_uri nbd "nbd://localhost";
let size = NBD.get_size nbd in
+ printf "%Ld\n" size;
+ NBD.close ()
+
+Alternate syntax which ensures that close is called even if an
+exception is thrown:
+
+ let size + NBD.with_handle (
+ fun nbd ->
+ NBD.connect_uri nbd "nbd://localhost";
+ NBD.get_size nbd
+ ) in
printf "%Ld\n" size
To compile:
@@ -36,6 +48,9 @@ it will be closed automatically when it is garbage collected.
If you
call any other method on a handle which you have explicitly closed
then the API will throw an C<NBD.Closed> exception.
+C<NBD.with_handle> can be used to make sure the handle is closed in a
+timely manner. See the example in the L</SYNOPSIS> above.
+
=head1 ERRORS
Libnbd errors are turned automatically into S<C<NBD.Error (str,
errno)>>
diff --git a/ocaml/tests/Makefile.am b/ocaml/tests/Makefile.am
index 6fac8b7c4..b89e807cc 100644
--- a/ocaml/tests/Makefile.am
+++ b/ocaml/tests/Makefile.am
@@ -22,6 +22,7 @@ CLEANFILES += *.annot *.cmi *.cmo *.cmx *.o *.a *.so *.bc
*.opt
EXTRA_DIST = \
test_010_import.ml \
test_100_handle.ml \
+ test_105_with_handle.ml \
test_110_defaults.ml \
test_120_set_non_defaults.ml \
test_130_private_data.ml \
@@ -49,6 +50,7 @@ if HAVE_NBDKIT
tests_bc = \
test_010_import.bc \
test_100_handle.bc \
+ test_105_with_handle.bc \
test_110_defaults.bc \
test_120_set_non_defaults.bc \
test_130_private_data.bc \
@@ -73,6 +75,7 @@ tests_bc = \
tests_opt = \
test_010_import.opt \
test_100_handle.opt \
+ test_105_with_handle.opt \
test_110_defaults.opt \
test_120_set_non_defaults.opt \
test_130_private_data.opt \
diff --git a/ocaml/tests/test_105_with_handle.ml
b/ocaml/tests/test_105_with_handle.ml
new file mode 100644
index 000000000..6957c0a71
--- /dev/null
+++ b/ocaml/tests/test_105_with_handle.ml
@@ -0,0 +1,37 @@
+(* hey emacs, this is OCaml code: -*- tuareg -*- *)
+(* libnbd OCaml test case
+ * Copyright (C) 2013-2021 Red Hat Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *)
+
+exception Test
+
+let () + NBD.with_handle (fun nbd -> ());
+
+ (try
+ ignore (NBD.with_handle (fun nbd -> raise Test));
+ assert false
+ with Test -> () (* expected *)
+ | exn -> failwith (Printexc.to_string exn)
+ );
+
+ (* Were two handles created above?
+ * XXX How to test if close was called twice?
+ *)
+ assert (NBD.get_handle_name (NBD.create ()) = "nbd3")
+
+let () = Gc.compact ()
diff --git a/ocaml/tests/test_110_defaults.ml b/ocaml/tests/test_110_defaults.ml
index f5886fca3..b36949f0b 100644
--- a/ocaml/tests/test_110_defaults.ml
+++ b/ocaml/tests/test_110_defaults.ml
@@ -18,18 +18,20 @@
*)
let () - let nbd = NBD.create () in
- let name = NBD.get_export_name nbd in
- assert (name = "");
- let info = NBD.get_full_info nbd in
- assert (info = false);
- let tls = NBD.get_tls nbd in
- assert (tls = NBD.TLS.DISABLE);
- let sr = NBD.get_request_structured_replies nbd in
- assert (sr = true);
- let flags = NBD.get_handshake_flags nbd in
- assert (flags = NBD.HANDSHAKE_FLAG.mask);
- let opt = NBD.get_opt_mode nbd in
- assert (opt = false)
+ NBD.with_handle (
+ fun nbd ->
+ let name = NBD.get_export_name nbd in
+ assert (name = "");
+ let info = NBD.get_full_info nbd in
+ assert (info = false);
+ let tls = NBD.get_tls nbd in
+ assert (tls = NBD.TLS.DISABLE);
+ let sr = NBD.get_request_structured_replies nbd in
+ assert (sr = true);
+ let flags = NBD.get_handshake_flags nbd in
+ assert (flags = NBD.HANDSHAKE_FLAG.mask);
+ let opt = NBD.get_opt_mode nbd in
+ assert (opt = false)
+ )
let () = Gc.compact ()
diff --git a/ocaml/tests/test_120_set_non_defaults.ml
b/ocaml/tests/test_120_set_non_defaults.ml
index 421baaba4..67928bb58 100644
--- a/ocaml/tests/test_120_set_non_defaults.ml
+++ b/ocaml/tests/test_120_set_non_defaults.ml
@@ -18,42 +18,44 @@
*)
let () - let nbd = NBD.create () in
- NBD.set_export_name nbd "name";
- let name = NBD.get_export_name nbd in
- assert (name = "name");
- NBD.set_full_info nbd true;
- let info = NBD.get_full_info nbd in
- assert (info = true);
- (try
- NBD.set_tls nbd (NBD.TLS.UNKNOWN 3);
- assert (false)
- with
- NBD.Error _ -> ()
- );
- let tls = NBD.get_tls nbd in
- assert (tls = NBD.TLS.DISABLE);
- if NBD.supports_tls nbd then (
- NBD.set_tls nbd NBD.TLS.ALLOW;
- let tls = NBD.get_tls nbd in
- assert (tls = NBD.TLS.ALLOW);
- );
- NBD.set_request_structured_replies nbd false;
- let sr = NBD.get_request_structured_replies nbd in
- assert (sr = false);
- (try
- NBD.set_handshake_flags nbd [ NBD.HANDSHAKE_FLAG.UNKNOWN 2 ];
- assert false
- with
- NBD.Error _ -> ()
- );
- let flags = NBD.get_handshake_flags nbd in
- assert (flags = NBD.HANDSHAKE_FLAG.mask);
- NBD.set_handshake_flags nbd [];
- let flags = NBD.get_handshake_flags nbd in
- assert (flags = []);
- NBD.set_opt_mode nbd true;
- let opt = NBD.get_opt_mode nbd in
- assert (opt = true)
+ NBD.with_handle (
+ fun nbd ->
+ NBD.set_export_name nbd "name";
+ let name = NBD.get_export_name nbd in
+ assert (name = "name");
+ NBD.set_full_info nbd true;
+ let info = NBD.get_full_info nbd in
+ assert (info = true);
+ (try
+ NBD.set_tls nbd (NBD.TLS.UNKNOWN 3);
+ assert (false)
+ with
+ NBD.Error _ -> ()
+ );
+ let tls = NBD.get_tls nbd in
+ assert (tls = NBD.TLS.DISABLE);
+ if NBD.supports_tls nbd then (
+ NBD.set_tls nbd NBD.TLS.ALLOW;
+ let tls = NBD.get_tls nbd in
+ assert (tls = NBD.TLS.ALLOW);
+ );
+ NBD.set_request_structured_replies nbd false;
+ let sr = NBD.get_request_structured_replies nbd in
+ assert (sr = false);
+ (try
+ NBD.set_handshake_flags nbd [ NBD.HANDSHAKE_FLAG.UNKNOWN 2 ];
+ assert false
+ with
+ NBD.Error _ -> ()
+ );
+ let flags = NBD.get_handshake_flags nbd in
+ assert (flags = NBD.HANDSHAKE_FLAG.mask);
+ NBD.set_handshake_flags nbd [];
+ let flags = NBD.get_handshake_flags nbd in
+ assert (flags = []);
+ NBD.set_opt_mode nbd true;
+ let opt = NBD.get_opt_mode nbd in
+ assert (opt = true)
+ )
let () = Gc.compact ()
diff --git a/ocaml/tests/test_200_connect_command.ml
b/ocaml/tests/test_200_connect_command.ml
index dd64b09f4..17d1b50ef 100644
--- a/ocaml/tests/test_200_connect_command.ml
+++ b/ocaml/tests/test_200_connect_command.ml
@@ -18,8 +18,11 @@
*)
let () - let nbd = NBD.create () in
- NBD.connect_command nbd
- ["nbdkit"; "-s";
"--exit-with-parent"; "-v"; "null"]
+ NBD.with_handle (
+ fun nbd ->
+ NBD.connect_command nbd
+ ["nbdkit"; "-s";
"--exit-with-parent"; "-v";
+ "null"]
+ )
let () = Gc.compact ()
diff --git a/ocaml/tests/test_400_pread.ml b/ocaml/tests/test_400_pread.ml
index b798633f0..e6b550ac9 100644
--- a/ocaml/tests/test_400_pread.ml
+++ b/ocaml/tests/test_400_pread.ml
@@ -37,12 +37,16 @@ let expected b
let () - let nbd = NBD.create () in
- NBD.connect_command nbd
- ["nbdkit"; "-s";
"--exit-with-parent"; "-v";
- "pattern"; "size=512"];
- let buf = Bytes.create 512 in
- NBD.pread nbd buf 0_L;
+ let buf + NBD.with_handle (
+ fun nbd ->
+ NBD.connect_command nbd
+ ["nbdkit"; "-s";
"--exit-with-parent"; "-v";
+ "pattern"; "size=512"];
+ let buf = Bytes.create 512 in
+ NBD.pread nbd buf 0_L;
+ buf
+ ) in
printf "buf = %S\n" (Bytes.to_string buf);
printf "expected = %S\n" (Bytes.to_string expected);
--
2.32.0
Laszlo Ersek
2021-Dec-13 11:56 UTC
[Libguestfs] [PATCH libnbd 2/2] ocaml: Add NBD.with_handle utility function
On 12/11/21 14:41, Richard W.M. Jones wrote:> NBD.with_handle (fun nbd -> ...) > > calls the inner function with a newly created handle, and ensures that > NBD.close is always called even if the inner function throws an > exception. > > This is inspired by Laszlo Ersek's similar function added to virt-v2v > lib/utils.ml in the commit below. Unlike that, this does not abstract > the connection and does not call NBD.shutdown. > > https://github.com/libguestfs/virt-v2v/commit/b4a8ccf00f1364d703c6d5cf1fd77850105fdd65 > > I adjusted one example and a few of the tests to use this function. > It is not really necessary to use it, so having a mix of both styles > seems reasonable. > --- > generator/OCaml.ml | 15 +++++ > ocaml/examples/extents.ml | 66 ++++++++++---------- > ocaml/libnbd-ocaml.pod | 15 +++++ > ocaml/tests/Makefile.am | 3 + > ocaml/tests/test_105_with_handle.ml | 37 ++++++++++++ > ocaml/tests/test_110_defaults.ml | 28 +++++---- > ocaml/tests/test_120_set_non_defaults.ml | 76 ++++++++++++------------ > ocaml/tests/test_200_connect_command.ml | 9 ++- > ocaml/tests/test_400_pread.ml | 16 +++-- > 9 files changed, 174 insertions(+), 91 deletions(-) > > diff --git a/generator/OCaml.ml b/generator/OCaml.ml > index 1349609bd..4e901648a 100644 > --- a/generator/OCaml.ml > +++ b/generator/OCaml.ml > @@ -225,6 +225,17 @@ val close : t -> unit > immediately. > *) > > +val with_handle : (t -> 'a) -> 'a > +(** Wrapper around {!create}. It calls the function parameter with a > + newly created handle, and ensures that {!close} is always called > + even if the function throws an exception. > + > + Use this when it is essential that the handle is closed in order > + to free up external resources in a timely manner; for example if > + running the server as a subprocess and you want to ensure that the > + subprocess is always killed; or if you need to disconnect from the > + server before continuing with another operation. *) > + > "; > > List.iter ( > @@ -315,6 +326,10 @@ type t > external create : unit -> t = \"nbd_internal_ocaml_nbd_create\" > external close : t -> unit = \"nbd_internal_ocaml_nbd_close\" > > +let with_handle f > + let nbd = create () in > + try let r = f nbd in close nbd; r with exn -> close nbd; raise exn > + > "; > > List.iter ( > diff --git a/ocaml/examples/extents.ml b/ocaml/examples/extents.ml > index e4422b270..58b4d56cb 100644 > --- a/ocaml/examples/extents.ml > +++ b/ocaml/examples/extents.ml > @@ -1,36 +1,38 @@ > open Printf > > let () > - let nbd = NBD.create () in > - NBD.add_meta_context nbd "base:allocation"; > - NBD.connect_command nbd > - ["nbdkit"; "-s"; "--exit-with-parent"; "-r"; > - "sparse-random"; "8G"]; > + NBD.with_handle ( > + fun nbd -> > + NBD.add_meta_context nbd "base:allocation"; > + NBD.connect_command nbd > + ["nbdkit"; "-s"; "--exit-with-parent"; "-r"; > + "sparse-random"; "8G"]; > > - (* Read the extents and print them. *) > - let size = NBD.get_size nbd in > - let fetch_offset = ref 0_L in > - while !fetch_offset < size do > - let remaining = Int64.sub size !fetch_offset in > - let fetch_size = min remaining 0x8000_0000_L in > - NBD.block_status nbd fetch_size !fetch_offset ( > - fun meta _ entries err -> > - printf "nbd_block_status callback: meta=%s err=%d\n" meta !err; > - if meta = "base:allocation" then ( > - printf "index\t%-20s %-20s %s\n" "offset" "length" "flags"; > - for i = 0 to Array.length entries / 2 - 1 do > - let len = Int64.of_int32 entries.(i*2) > - and flags > - match entries.(i*2+1) with > - | 0_l -> "data" > - | 1_l -> "hole" > - | 2_l -> "zero" > - | 3_l -> "hole+zero" > - | i -> sprintf "unknown (%ld)" i in > - printf "%d:\t%-20Ld %-20Ld %s\n" i !fetch_offset len flags; > - fetch_offset := Int64.add !fetch_offset len > - done; > - ); > - 0 > - ) (* NBD.block_status *) > - done > + (* Read the extents and print them. *) > + let size = NBD.get_size nbd in > + let fetch_offset = ref 0_L in > + while !fetch_offset < size do > + let remaining = Int64.sub size !fetch_offset in > + let fetch_size = min remaining 0x8000_0000_L in > + NBD.block_status nbd fetch_size !fetch_offset ( > + fun meta _ entries err -> > + printf "nbd_block_status callback: meta=%s err=%d\n" meta !err; > + if meta = "base:allocation" then ( > + printf "index\t%-20s %-20s %s\n" "offset" "length" "flags"; > + for i = 0 to Array.length entries / 2 - 1 do > + let len = Int64.of_int32 entries.(i*2) > + and flags > + match entries.(i*2+1) with > + | 0_l -> "data" > + | 1_l -> "hole" > + | 2_l -> "zero" > + | 3_l -> "hole+zero" > + | i -> sprintf "unknown (%ld)" i in > + printf "%d:\t%-20Ld %-20Ld %s\n" i !fetch_offset len flags; > + fetch_offset := Int64.add !fetch_offset len > + done; > + ); > + 0 > + ) (* NBD.block_status *) > + done > + ) > diff --git a/ocaml/libnbd-ocaml.pod b/ocaml/libnbd-ocaml.pod > index 19825805b..ebcce37cf 100644 > --- a/ocaml/libnbd-ocaml.pod > +++ b/ocaml/libnbd-ocaml.pod > @@ -7,6 +7,18 @@ libnbd-ocaml - how to use libnbd from OCaml > let nbd = NBD.create () in > NBD.connect_uri nbd "nbd://localhost"; > let size = NBD.get_size nbd in > + printf "%Ld\n" size; > + NBD.close () > + > +Alternate syntax which ensures that close is called even if an > +exception is thrown: > + > + let size > + NBD.with_handle ( > + fun nbd -> > + NBD.connect_uri nbd "nbd://localhost"; > + NBD.get_size nbd > + ) in > printf "%Ld\n" size > > To compile: > @@ -36,6 +48,9 @@ it will be closed automatically when it is garbage collected. If you > call any other method on a handle which you have explicitly closed > then the API will throw an C<NBD.Closed> exception. > > +C<NBD.with_handle> can be used to make sure the handle is closed in a > +timely manner. See the example in the L</SYNOPSIS> above. > + > =head1 ERRORS > > Libnbd errors are turned automatically into S<C<NBD.Error (str, errno)>> > diff --git a/ocaml/tests/Makefile.am b/ocaml/tests/Makefile.am > index 6fac8b7c4..b89e807cc 100644 > --- a/ocaml/tests/Makefile.am > +++ b/ocaml/tests/Makefile.am > @@ -22,6 +22,7 @@ CLEANFILES += *.annot *.cmi *.cmo *.cmx *.o *.a *.so *.bc *.opt > EXTRA_DIST = \ > test_010_import.ml \ > test_100_handle.ml \ > + test_105_with_handle.ml \ > test_110_defaults.ml \ > test_120_set_non_defaults.ml \ > test_130_private_data.ml \ > @@ -49,6 +50,7 @@ if HAVE_NBDKIT > tests_bc = \ > test_010_import.bc \ > test_100_handle.bc \ > + test_105_with_handle.bc \ > test_110_defaults.bc \ > test_120_set_non_defaults.bc \ > test_130_private_data.bc \ > @@ -73,6 +75,7 @@ tests_bc = \ > tests_opt = \ > test_010_import.opt \ > test_100_handle.opt \ > + test_105_with_handle.opt \ > test_110_defaults.opt \ > test_120_set_non_defaults.opt \ > test_130_private_data.opt \ > diff --git a/ocaml/tests/test_105_with_handle.ml b/ocaml/tests/test_105_with_handle.ml > new file mode 100644 > index 000000000..6957c0a71 > --- /dev/null > +++ b/ocaml/tests/test_105_with_handle.ml > @@ -0,0 +1,37 @@ > +(* hey emacs, this is OCaml code: -*- tuareg -*- *) > +(* libnbd OCaml test case > + * Copyright (C) 2013-2021 Red Hat Inc. > + * > + * This library is free software; you can redistribute it and/or > + * modify it under the terms of the GNU Lesser General Public > + * License as published by the Free Software Foundation; either > + * version 2 of the License, or (at your option) any later version. > + * > + * This library is distributed in the hope that it will be useful, > + * but WITHOUT ANY WARRANTY; without even the implied warranty of > + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU > + * Lesser General Public License for more details. > + * > + * You should have received a copy of the GNU Lesser General Public > + * License along with this library; if not, write to the Free Software > + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA > + *) > + > +exception Test > + > +let () > + NBD.with_handle (fun nbd -> ()); > + > + (try > + ignore (NBD.with_handle (fun nbd -> raise Test)); > + assert false > + with Test -> () (* expected *) > + | exn -> failwith (Printexc.to_string exn) > + ); > + > + (* Were two handles created above? > + * XXX How to test if close was called twice?I think we can just trust that :) Otherwise we'd have to add another (optional) close-like callback to "with_handle", e.g. a function to increment a mutable integer. Reviewed-by: Laszlo Ersek <lersek at redhat.com> Thanks Laszlo> + *) > + assert (NBD.get_handle_name (NBD.create ()) = "nbd3") > + > +let () = Gc.compact () > diff --git a/ocaml/tests/test_110_defaults.ml b/ocaml/tests/test_110_defaults.ml > index f5886fca3..b36949f0b 100644 > --- a/ocaml/tests/test_110_defaults.ml > +++ b/ocaml/tests/test_110_defaults.ml > @@ -18,18 +18,20 @@ > *) > > let () > - let nbd = NBD.create () in > - let name = NBD.get_export_name nbd in > - assert (name = ""); > - let info = NBD.get_full_info nbd in > - assert (info = false); > - let tls = NBD.get_tls nbd in > - assert (tls = NBD.TLS.DISABLE); > - let sr = NBD.get_request_structured_replies nbd in > - assert (sr = true); > - let flags = NBD.get_handshake_flags nbd in > - assert (flags = NBD.HANDSHAKE_FLAG.mask); > - let opt = NBD.get_opt_mode nbd in > - assert (opt = false) > + NBD.with_handle ( > + fun nbd -> > + let name = NBD.get_export_name nbd in > + assert (name = ""); > + let info = NBD.get_full_info nbd in > + assert (info = false); > + let tls = NBD.get_tls nbd in > + assert (tls = NBD.TLS.DISABLE); > + let sr = NBD.get_request_structured_replies nbd in > + assert (sr = true); > + let flags = NBD.get_handshake_flags nbd in > + assert (flags = NBD.HANDSHAKE_FLAG.mask); > + let opt = NBD.get_opt_mode nbd in > + assert (opt = false) > + ) > > let () = Gc.compact () > diff --git a/ocaml/tests/test_120_set_non_defaults.ml b/ocaml/tests/test_120_set_non_defaults.ml > index 421baaba4..67928bb58 100644 > --- a/ocaml/tests/test_120_set_non_defaults.ml > +++ b/ocaml/tests/test_120_set_non_defaults.ml > @@ -18,42 +18,44 @@ > *) > > let () > - let nbd = NBD.create () in > - NBD.set_export_name nbd "name"; > - let name = NBD.get_export_name nbd in > - assert (name = "name"); > - NBD.set_full_info nbd true; > - let info = NBD.get_full_info nbd in > - assert (info = true); > - (try > - NBD.set_tls nbd (NBD.TLS.UNKNOWN 3); > - assert (false) > - with > - NBD.Error _ -> () > - ); > - let tls = NBD.get_tls nbd in > - assert (tls = NBD.TLS.DISABLE); > - if NBD.supports_tls nbd then ( > - NBD.set_tls nbd NBD.TLS.ALLOW; > - let tls = NBD.get_tls nbd in > - assert (tls = NBD.TLS.ALLOW); > - ); > - NBD.set_request_structured_replies nbd false; > - let sr = NBD.get_request_structured_replies nbd in > - assert (sr = false); > - (try > - NBD.set_handshake_flags nbd [ NBD.HANDSHAKE_FLAG.UNKNOWN 2 ]; > - assert false > - with > - NBD.Error _ -> () > - ); > - let flags = NBD.get_handshake_flags nbd in > - assert (flags = NBD.HANDSHAKE_FLAG.mask); > - NBD.set_handshake_flags nbd []; > - let flags = NBD.get_handshake_flags nbd in > - assert (flags = []); > - NBD.set_opt_mode nbd true; > - let opt = NBD.get_opt_mode nbd in > - assert (opt = true) > + NBD.with_handle ( > + fun nbd -> > + NBD.set_export_name nbd "name"; > + let name = NBD.get_export_name nbd in > + assert (name = "name"); > + NBD.set_full_info nbd true; > + let info = NBD.get_full_info nbd in > + assert (info = true); > + (try > + NBD.set_tls nbd (NBD.TLS.UNKNOWN 3); > + assert (false) > + with > + NBD.Error _ -> () > + ); > + let tls = NBD.get_tls nbd in > + assert (tls = NBD.TLS.DISABLE); > + if NBD.supports_tls nbd then ( > + NBD.set_tls nbd NBD.TLS.ALLOW; > + let tls = NBD.get_tls nbd in > + assert (tls = NBD.TLS.ALLOW); > + ); > + NBD.set_request_structured_replies nbd false; > + let sr = NBD.get_request_structured_replies nbd in > + assert (sr = false); > + (try > + NBD.set_handshake_flags nbd [ NBD.HANDSHAKE_FLAG.UNKNOWN 2 ]; > + assert false > + with > + NBD.Error _ -> () > + ); > + let flags = NBD.get_handshake_flags nbd in > + assert (flags = NBD.HANDSHAKE_FLAG.mask); > + NBD.set_handshake_flags nbd []; > + let flags = NBD.get_handshake_flags nbd in > + assert (flags = []); > + NBD.set_opt_mode nbd true; > + let opt = NBD.get_opt_mode nbd in > + assert (opt = true) > + ) > > let () = Gc.compact () > diff --git a/ocaml/tests/test_200_connect_command.ml b/ocaml/tests/test_200_connect_command.ml > index dd64b09f4..17d1b50ef 100644 > --- a/ocaml/tests/test_200_connect_command.ml > +++ b/ocaml/tests/test_200_connect_command.ml > @@ -18,8 +18,11 @@ > *) > > let () > - let nbd = NBD.create () in > - NBD.connect_command nbd > - ["nbdkit"; "-s"; "--exit-with-parent"; "-v"; "null"] > + NBD.with_handle ( > + fun nbd -> > + NBD.connect_command nbd > + ["nbdkit"; "-s"; "--exit-with-parent"; "-v"; > + "null"] > + ) > > let () = Gc.compact () > diff --git a/ocaml/tests/test_400_pread.ml b/ocaml/tests/test_400_pread.ml > index b798633f0..e6b550ac9 100644 > --- a/ocaml/tests/test_400_pread.ml > +++ b/ocaml/tests/test_400_pread.ml > @@ -37,12 +37,16 @@ let expected > b > > let () > - let nbd = NBD.create () in > - NBD.connect_command nbd > - ["nbdkit"; "-s"; "--exit-with-parent"; "-v"; > - "pattern"; "size=512"]; > - let buf = Bytes.create 512 in > - NBD.pread nbd buf 0_L; > + let buf > + NBD.with_handle ( > + fun nbd -> > + NBD.connect_command nbd > + ["nbdkit"; "-s"; "--exit-with-parent"; "-v"; > + "pattern"; "size=512"]; > + let buf = Bytes.create 512 in > + NBD.pread nbd buf 0_L; > + buf > + ) in > > printf "buf = %S\n" (Bytes.to_string buf); > printf "expected = %S\n" (Bytes.to_string expected); >