[Libguestfs] [libnbd PATCH v2 3/3] ocaml: Typesafe returns for REnum/RFlags
Eric Blake
eblake at redhat.com
Mon Sep 7 21:45:36 UTC 2020
Now that we have a distinct branch in the generator when returning an
enum or bitmask that cannot fail, we can use it in OCaml for symmetry,
so that the result of a get function can be plugged into a set
function without manual conversion of an integer. This includes the
use of the recently-added UNKNOWN catch-all for encoding C values
returned by a newer libnbd.so than when the OCaml bindings were
compiled.
---
generator/OCaml.ml | 77 ++++++++++++++++++++++--
ocaml/tests/test_110_defaults.ml | 5 +-
ocaml/tests/test_120_set_non_defaults.ml | 9 +--
3 files changed, 79 insertions(+), 12 deletions(-)
diff --git a/generator/OCaml.ml b/generator/OCaml.ml
index db7003c..4bcd450 100644
--- a/generator/OCaml.ml
+++ b/generator/OCaml.ml
@@ -66,8 +66,8 @@ and ocaml_ret_to_string = function
| RCookie -> "cookie"
| RString -> "string"
| RUInt -> "int"
- | REnum _ -> "int" (* XXX return enum_prefix.t instead *)
- | RFlags _ -> "int" (* XXX return flag_prefix.t list instead *)
+ | REnum { enum_prefix } -> enum_prefix ^ ".t"
+ | RFlags { flag_prefix } -> flag_prefix ^ ".t list"
and ocaml_optarg_to_string = function
| OClosure { cbname; cbargs } ->
@@ -344,7 +344,34 @@ let print_ocaml_enum_val { enum_prefix; enums } =
pr "\n";
pr " return r;\n";
pr "}\n";
- pr "\n"
+ pr "\n";
+ if List.exists (
+ function
+ | _, { ret = REnum { enum_prefix = prefix } } ->
+ (prefix = enum_prefix)
+ | _ -> false
+ ) handle_calls then (
+ pr "/* Convert int to OCaml %s.t. */\n" enum_prefix;
+ pr "static value\n";
+ pr "Val_%s (int i)\n" enum_prefix;
+ pr "{\n";
+ pr " CAMLparam0 ();\n";
+ pr " CAMLlocal1 (rv);\n";
+ pr "\n";
+ pr " switch (i) {\n";
+ List.iteri (
+ fun i (enum, _) ->
+ pr " case LIBNBD_%s_%s: rv = Val_int (%d); break;\n" enum_prefix enum i
+ ) enums;
+ pr " default:\n";
+ pr " rv = caml_alloc (1, 0); /* UNKNOWN of int */\n";
+ pr " Store_field (rv, 0, Val_int (i));\n";
+ pr " }\n";
+ pr "\n";
+ pr " CAMLreturn (rv);\n";
+ pr "}\n";
+ pr "\n"
+ )
let print_ocaml_flag_val { flag_prefix; flags } =
pr "/* Convert OCaml %s.t list to uint32_t bitmask. */\n" flag_prefix;
@@ -385,7 +412,45 @@ let print_ocaml_flag_val { flag_prefix; flags } =
pr "\n";
pr " return r;\n";
pr "}\n";
- pr "\n"
+ pr "\n";
+ if List.exists (
+ function
+ | _, { ret = RFlags { flag_prefix = prefix } } ->
+ (prefix = flag_prefix)
+ | _ -> false
+ ) handle_calls then (
+ pr "/* Convert uint32_t bitmask to OCaml %s.t list. */\n" flag_prefix;
+ pr "static value\n";
+ pr "Val_%s (unsigned flags)\n" flag_prefix;
+ pr "{\n";
+ pr " CAMLparam0 ();\n";
+ pr " CAMLlocal3 (cdr, rv, v);\n";
+ pr " int i;\n";
+ pr "\n";
+ pr " rv = Val_emptylist;\n";
+ pr " for (i = 31; i >= 0; i--) {\n";
+ pr " if (flags & (1 << i)) {\n";
+ pr " switch (1 << i) {\n";
+ List.iteri (
+ fun i (flag, _) ->
+ pr " case LIBNBD_%s_%s: v = Val_int (%d); break;\n" flag_prefix flag i;
+ ) flags;
+ pr " default:\n";
+ pr " v = caml_alloc (1, 0); /* UNKNOWN of int */\n";
+ pr " Store_field (v, 0, Val_int (i));\n";
+ pr " }\n";
+ pr "\n";
+ pr " cdr = rv;\n";
+ pr " rv = caml_alloc (2, 0);\n";
+ pr " Store_field (rv, 0, v);\n";
+ pr " Store_field (rv, 1, cdr);\n";
+ pr " }\n";
+ pr " }\n";
+ pr "\n";
+ pr " CAMLreturn (rv);\n";
+ pr "}\n";
+ pr "\n"
+ )
let print_ocaml_closure_wrapper { cbname; cbargs } =
let argnames =
@@ -639,8 +704,8 @@ let print_ocaml_binding (name, { args; optargs; ret }) =
| RBool -> pr " rv = Val_bool (r);\n"
| RErr -> pr " rv = Val_unit;\n"
| RFd | RInt | RUInt -> pr " rv = Val_int (r);\n"
- | REnum _ -> pr " rv = Val_int (r);\n" (* XXX Use Val_enum_prefix() *)
- | RFlags _ -> pr " rv = Val_int (r);\n" (* XXX Use Val_flag_prefix() *)
+ | REnum { enum_prefix } -> pr " rv = Val_%s (r);\n" enum_prefix
+ | RFlags { flag_prefix } -> pr " rv = Val_%s (r);\n" flag_prefix
| RInt64 | RCookie -> pr " rv = caml_copy_int64 (r);\n"
| RStaticString -> pr " rv = caml_copy_string (r);\n"
| RString ->
diff --git a/ocaml/tests/test_110_defaults.ml b/ocaml/tests/test_110_defaults.ml
index 6953b2d..54f2cbc 100644
--- a/ocaml/tests/test_110_defaults.ml
+++ b/ocaml/tests/test_110_defaults.ml
@@ -24,11 +24,12 @@ let () =
let info = NBD.get_full_info nbd in
assert (info = false);
let tls = NBD.get_tls nbd in
- assert (tls = 0); (* XXX Add REnum, to get NBD.TLS.DISABLE? *)
+ 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 = 3); (* XXX Add RFlags, to get NBD.HANDSHAKE_FLAG list? *)
+ assert (flags = [ NBD.HANDSHAKE_FLAG.FIXED_NEWSTYLE;
+ NBD.HANDSHAKE_FLAG.NO_ZEROES ]);
let opt = NBD.get_opt_mode nbd in
assert (opt = false)
diff --git a/ocaml/tests/test_120_set_non_defaults.ml b/ocaml/tests/test_120_set_non_defaults.ml
index 0d14710..79fe184 100644
--- a/ocaml/tests/test_120_set_non_defaults.ml
+++ b/ocaml/tests/test_120_set_non_defaults.ml
@@ -31,11 +31,11 @@ let () =
with
NBD.Error _ -> ();
let tls = NBD.get_tls nbd in
- assert (tls = 0); (* XXX Add REnum, to get NBD.TLS.DISABLE? *)
+ 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 = 1); (* XXX Add REnum *)
+ assert (tls = NBD.TLS.ALLOW);
);
NBD.set_request_structured_replies nbd false;
let sr = NBD.get_request_structured_replies nbd in
@@ -46,10 +46,11 @@ let () =
with
NBD.Error _ -> ();
let flags = NBD.get_handshake_flags nbd in
- assert (flags = 3); (* XXX Add RFlags, to get NBD.HANDSHAKE_FLAG list? *)
+ assert (flags = [ NBD.HANDSHAKE_FLAG.FIXED_NEWSTYLE;
+ NBD.HANDSHAKE_FLAG.NO_ZEROES ]);
NBD.set_handshake_flags nbd [];
let flags = NBD.get_handshake_flags nbd in
- assert (flags = 0); (* XXX Add RFlags *)
+ assert (flags = []);
NBD.set_opt_mode nbd true;
let opt = NBD.get_opt_mode nbd in
assert (opt = true)
--
2.28.0
More information about the Libguestfs
mailing list