[Libguestfs] [libnbd PATCH 3/3] ocaml: Typesafe returns for REnum/RFlags

[Eric Blake]

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.

While at it, add an abort() if OCaml ever hands us a value we can't
translate to a C int (that one is unreachable per OCaml type safety),
or if we ever get an int from libnbd that we can't translate to an
OCaml type (that one is theoretically probable; perhaps it should
raise an OCaml exception instead?).
---
 generator/OCaml.ml                       | 59 ++++++++++++++++++++++--
 ocaml/tests/test_110_defaults.ml         |  5 +-
 ocaml/tests/test_120_set_non_defaults.ml |  4 +-
 3 files changed, 60 insertions(+), 8 deletions(-)

diff --git a/generator/OCaml.ml b/generator/OCaml.ml
index 4a835b0..cb6633c 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 } ->
@@ -332,10 +332,33 @@ let print_ocaml_enum_val { enum_prefix; enums } =
     fun i (enum, _) ->
       pr "  case %d: r = LIBNBD_%s_%s; break;\n" i enum_prefix enum
   ) enums;
+  pr "  default: abort ();\n";
   pr "  }\n";
   pr "\n";
   pr "  return r;\n";
   pr "}\n";
+  pr "\n";
+  pr "/* Convert int to OCaml %s.t. */\n" enum_prefix;
+  (* Easier to mark function as potentially unused than to search whether
+   * any REnum references this type.
+   *)
+  pr "static value __attribute__ ((unused))\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;
+  (* Possible if newer libnbd returns value not present in older compilation *)
+  pr "  default: abort ();\n";
+  pr "  }\n";
+  pr "\n";
+  pr "  CAMLreturn (rv);\n";
+  pr "}\n";
   pr "\n"

 let print_ocaml_flag_val { flag_prefix; flags } =
@@ -360,9 +383,37 @@ let print_ocaml_flag_val { flag_prefix; flags } =
     fun i (flag, _) ->
       pr "    case %d: r |= LIBNBD_%s_%s; break;\n" i flag_prefix flag
   ) flags;
+  pr "    default: abort ();\n";
   pr "    }\n";
   pr "  }\n";
   pr "\n";
   pr "  return r;\n";
   pr "}\n";
+  pr "\n";
+  pr "/* Convert uint32_t bitmask to OCaml %s.t list. */\n" flag_prefix;
+  (* Easier to mark function as potentially unused than to search whether
+   * any RFlags references this type.
+   *)
+  pr "static value __attribute__ ((unused))\n";
+  pr "Val_%s (unsigned i)\n" flag_prefix;
+  pr "{\n";
+  pr "  CAMLparam0 ();\n";
+  pr "  CAMLlocal2 (cdr, rv);\n";
+  pr "\n";
+  pr "  cdr = Val_emptylist;\n";
+  List.iteri (
+    fun i (flag, _) ->
+      pr "  if (i & LIBNBD_%s_%s) {\n" flag_prefix flag;
+      pr "    rv = caml_alloc(2, 0);\n";
+      pr "    Store_field(rv, 0, Val_int(%d));\n" i;
+      pr "    Store_field(rv, 1, cdr);\n";
+      pr "    cdr = rv;\n";
+      pr "    i &= ~LIBNBD_%s_%s;\n" flag_prefix flag;
+      pr "  }\n"
+  ) flags;
+  (* Possible if newer libnbd returns value not present in older compilation *)
+  pr "  if (i) abort ();\n";
+  pr "\n";
+  pr "  CAMLreturn (rv);\n";
+  pr "}\n";
   pr "\n"

 let print_ocaml_closure_wrapper { cbname; cbargs } =
@@ -619,8 +670,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..f969b2f 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.NO_ZEROES;
+                    NBD.HANDSHAKE_FLAG.FIXED_NEWSTYLE ]);
   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 bd41e37..df3d479 100644
--- a/ocaml/tests/test_120_set_non_defaults.ml
+++ b/ocaml/tests/test_120_set_non_defaults.ml
@@ -28,14 +28,14 @@ let () =
   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
   assert (sr = false);
   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