[Libguestfs] [libnbd PATCH v2 2/3] ocaml: Support unknown values for Enum/Flags

[Eric Blake]

Of our existing enum types, tls_enum is probably not going to extend,
but block_size_enum definitely will.  Similarly, for our flags types,
all of them have the possibility of future NBD protocol additions
defining new bit positions.  While it is nice to name known bits, the
typical OCaml variant representation of an extendible C enum also
includes a catch-all constructor for unknown C values (see for example
Unix.error with its 'EUNKNOWNERR of int').

Our C code rejects unknown values, but allowing OCaml the flexibility
of passing in all valid C values, rather than just the ones that were
known at the time the OCaml bindings were compiled, lets us deal with
situations where a newer libnbd.so could return a new bit in a get_*
function, and where we want to leave that bit still set in the
corresponding set_* function.  And it lets us match the testsuite
coverage to the support present in other languages in the previous
patch.

Thanks: Rich Jones
---
 generator/OCaml.ml                       | 46 +++++++++++++++++-------
 ocaml/tests/test_120_set_non_defaults.ml | 16 +++++----
 2 files changed, 43 insertions(+), 19 deletions(-)

diff --git a/generator/OCaml.ml b/generator/OCaml.ml
index 63f442c..db7003c 100644
--- a/generator/OCaml.ml
+++ b/generator/OCaml.ml
@@ -151,6 +151,7 @@ type cookie = int64
         fun (enum, _) ->
           pr "  | %s\n" enum
       ) enums;
+      pr "  | UNKNOWN of int\n";
       pr "end\n";
       pr "\n"
   ) all_enums;
@@ -162,6 +163,7 @@ type cookie = int64
         fun (flag, _) ->
           pr "  | %s\n" flag
       ) flags;
+      pr "  | UNKNOWN of int\n";
       pr "end\n";
       pr "\n"
   ) all_flags;
@@ -254,6 +256,7 @@ let () =
         fun (enum, _) ->
           pr "  | %s\n" enum
       ) enums;
+      pr "  | UNKNOWN of int\n";
       pr "end\n";
       pr "\n"
   ) all_enums;
@@ -265,6 +268,7 @@ let () =
         fun (flag, _) ->
           pr "  | %s\n" flag
       ) flags;
+      pr "  | UNKNOWN of int\n";
       pr "end\n";
       pr "\n"
   ) all_flags;
@@ -320,19 +324,23 @@ let print_ocaml_enum_val { enum_prefix; enums } =
   pr "  /* NB: No allocation in this function, don't need to use\n";
   pr "   * CAML* wrappers.\n";
   pr "   */\n";
-  pr "  int i, r = 0;\n";
+  pr "  int r = 0;\n";
   pr "\n";
-  pr "  i = Int_val (v);\n";
-  pr "  /* i is the index of the enum in the type\n";
-  pr "   * (eg. i = 0 => enum = %s.%s).\n" enum_prefix (fst (List.hd enums));
-  pr "   * Convert it to the C representation.\n";
-  pr "   */\n";
-  pr "  switch (i) {\n";
+  pr "  if (Is_long (v)) {\n";
+  pr "    /* Int_val (v) is the index of the enum in the type\n";
+  pr "     * (eg. v = 0 => enum = %s.%s).\n" enum_prefix (fst (List.hd enums));
+  pr "     * Convert it to the C representation.\n";
+  pr "     */\n";
+  pr "    switch (Int_val (v)) {\n";
   List.iteri (
     fun i (enum, _) ->
-      pr "  case %d: r = LIBNBD_%s_%s; break;\n" i enum_prefix enum
+      pr "    case %d: r = LIBNBD_%s_%s; break;\n" i enum_prefix enum
   ) enums;
+  pr "    default: abort ();\n";
+  pr "    }\n";
   pr "  }\n";
+  pr "  else\n";
+  pr "    r = Int_val (Field (v, 0)); /* UNKNOWN of int */\n";
   pr "\n";
   pr "  return r;\n";
   pr "}\n";
@@ -346,20 +354,32 @@ let print_ocaml_flag_val { flag_prefix; flags } =
   pr "  /* NB: No allocation in this function, don't need to use\n";
   pr "   * CAML* wrappers.\n";
   pr "   */\n";
-  pr "  int i;\n";
+  pr "  value i;\n";
+  pr "  unsigned bit;\n";
   pr "  uint32_t r = 0;\n";
   pr "\n";
   pr "  for (; v != Val_emptylist; v = Field (v, 1)) {\n";
-  pr "    i = Int_val (Field (v, 0));\n";
-  pr "    /* i is the index of the flag in the type\n";
+  pr "    i = Field (v, 0);\n";
+  pr "    /* i contains either the index of the flag in the type,\n";
+  pr "     * or UNKNOWN of int containing the bit position.\n";
   pr "     * (eg. i = 0 => flag = %s.%s).\n" flag_prefix (fst (List.hd flags));
   pr "     * Convert it to the C representation.\n";
   pr "     */\n";
-  pr "    switch (i) {\n";
+  pr "    if (Is_long (i)) {\n";
+  pr "      switch (Int_val (i)) {\n";
   List.iteri (
     fun i (flag, _) ->
-      pr "    case %d: r |= LIBNBD_%s_%s; break;\n" i flag_prefix flag
+      pr "      case %d: r |= LIBNBD_%s_%s; break;\n" i flag_prefix flag
   ) flags;
+  pr "      default: abort ();\n";
+  pr "      }\n";
+  pr "    }\n";
+  pr "    else {\n";
+  pr "      bit = Int_val (Field (i, 0)); /* UNKNOWN of int */\n";
+  pr "      if (bit > 31)\n";
+  pr "        caml_invalid_argument (\"bitmask value out of range\");\n";
+  pr "      else\n";
+  pr "        r |= 1 << bit;\n";
   pr "    }\n";
   pr "  }\n";
   pr "\n";
diff --git a/ocaml/tests/test_120_set_non_defaults.ml b/ocaml/tests/test_120_set_non_defaults.ml
index e616291..0d14710 100644
--- a/ocaml/tests/test_120_set_non_defaults.ml
+++ b/ocaml/tests/test_120_set_non_defaults.ml
@@ -25,9 +25,11 @@ let () =
   NBD.set_full_info nbd true;
   let info = NBD.get_full_info nbd in
   assert (info = true);
-  (* XXX No way to pass out-of-range enum...
-     try NBD.set_tls nbd XXX
-   *)
+  try
+    NBD.set_tls nbd (NBD.TLS.UNKNOWN 3);
+    assert (false)
+  with
+    NBD.Error _ -> ();
   let tls = NBD.get_tls nbd in
   assert (tls = 0);   (* XXX Add REnum, to get NBD.TLS.DISABLE? *)
   if NBD.supports_tls nbd then (
@@ -38,9 +40,11 @@ let () =
   NBD.set_request_structured_replies nbd false;
   let sr = NBD.get_request_structured_replies nbd in
   assert (sr = false);
-  (* XXX No way to pass out-of-range flags...
-     try NBD.set_handshake_flags nbd [ XXX ]
-   *)
+  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 = 3); (* XXX Add RFlags, to get NBD.HANDSHAKE_FLAG list? *)
   NBD.set_handshake_flags nbd [];
-- 
2.28.0