[Libguestfs] [PATCH] generator: Share Common_utils code.
Richard W.M. Jones
rjones at redhat.com
Thu Dec 8 10:36:45 UTC 2016
For a very long time we have maintained two sets of utility functions,
in mllib/common_utils.ml and generator/utils.ml. This changes things
so that the same set of utility functions can be shared with both
directories.
It's not possible to use common_utils.ml directly in the generator
because it provides several functions that use modules outside the
OCaml stdlib. Therefore we add some lightweight post-processing which
extracts the functions using only the stdlib:
(*<stdlib>*)
...
(*</stdlib>*)
and creates generator/common_utils.ml and generator/common_utils.mli
from that. The effect is we only need to write utility functions
once.
As with other tools, we still have generator-specific utility
functions in generator/utils.ml.
Also in this change:
- Use String.uppercase_ascii and String.lowercase_ascii in place
of deprecated String.uppercase/String.lowercase.
- Implement String.capitalize_ascii to replace deprecated
String.capitalize.
- Move isspace, isdigit, isxdigit functions to Char module.
---
.gitignore | 3 +
dib/utils.ml | 2 +-
generator/Makefile.am | 23 ++++++-
generator/bindtests.ml | 25 +++----
generator/c.ml | 53 ++++++++-------
generator/daemon.ml | 10 +--
generator/docstrings.ml | 3 +-
generator/erlang.ml | 23 ++++---
generator/events.ml | 1 +
generator/fish.ml | 34 +++++-----
generator/gobject.ml | 32 +++++----
generator/java.ml | 8 ++-
generator/lua.ml | 3 +-
generator/ocaml.ml | 11 +--
generator/perl.ml | 11 +--
generator/pr.ml | 3 +-
generator/python.ml | 25 +++----
generator/ruby.ml | 11 +--
generator/tests_c_api.ml | 13 ++--
generator/uefi.ml | 1 +
generator/utils.ml | 173 ++++-------------------------------------------
generator/utils.mli | 64 +-----------------
mllib/common_utils.ml | 126 ++++++++++++++++++++++++++++++----
mllib/common_utils.mli | 76 ++++++++++++++++++---
v2v/convert_windows.ml | 3 +-
25 files changed, 373 insertions(+), 364 deletions(-)
diff --git a/.gitignore b/.gitignore
index 633b39d..da59e44 100644
--- a/.gitignore
+++ b/.gitignore
@@ -255,8 +255,11 @@ Makefile.in
/fuse/test-guestunmount-fd
/generator/.depend
/generator/bytes.ml
+/generator/common_utils.ml
+/generator/common_utils.mli
/generator/files-generated.txt
/generator/generator
+/generator/guestfs_config.ml
/generator/.pod2text.data*
/generator/stamp-generator
/get-kernel/.depend
diff --git a/dib/utils.ml b/dib/utils.ml
index 3df5171..4026ee8 100644
--- a/dib/utils.ml
+++ b/dib/utils.ml
@@ -74,7 +74,7 @@ let digit_prefix_compare a b =
let split_prefix str =
let len = String.length str in
let digits =
- try string_index_fn (fun x -> not (isdigit x)) str
+ try string_index_fn (fun x -> not (Char.isdigit x)) str
with Not_found -> len in
match digits with
| 0 -> "", str
diff --git a/generator/Makefile.am b/generator/Makefile.am
index 31c33fa..0c2ae33 100644
--- a/generator/Makefile.am
+++ b/generator/Makefile.am
@@ -27,6 +27,8 @@ sources = \
c.mli \
checks.ml \
checks.mli \
+ common_utils.ml \
+ common_utils.mli \
csharp.ml \
csharp.mli \
customize.ml \
@@ -47,6 +49,7 @@ sources = \
gobject.mli \
golang.ml \
golang.mli \
+ guestfs_config.ml \
haskell.ml \
haskell.mli \
java.ml \
@@ -85,6 +88,8 @@ sources = \
# In build dependency order.
objects = \
$(OCAML_GENERATOR_BYTES_COMPAT_CMO) \
+ guestfs_config.cmo \
+ common_utils.cmo \
types.cmo \
utils.cmo \
actions.cmo \
@@ -133,7 +138,7 @@ generator: $(objects)
# Dependencies.
depend: .depend
-.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
+.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) common_utils.ml common_utils.mli guestfs_config.ml
rm -f $@ $@-t
$(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) $^ | \
$(SED) 's/ *$$//' | \
@@ -174,6 +179,22 @@ stamp-generator: generator
cd $(top_srcdir) && $(abs_builddir)/generator
touch $@
+# We share common_utils.ml{,i} with the mllib directory. However we
+# have to remove functions which depend on any modules which are not
+# part of the OCaml stdlib.
+common_utils.ml: $(top_srcdir)/mllib/common_utils.ml
+ rm -f $@ $@-t
+ echo '(* This file is generated from mllib/common_utils.ml *)' > $@-t
+ sed -n '/^(\*<stdlib>\*)$$/,/^(\*<\/stdlib>\*)$$/p' $< >> $@-t
+ mv $@-t $@
+common_utils.mli: $(top_srcdir)/mllib/common_utils.mli
+ rm -f $@ $@-t
+ echo '(* This file is generated from mllib/common_utils.mli *)' > $@-t
+ sed -n '/^(\*<stdlib>\*)$$/,/^(\*<\/stdlib>\*)$$/p' $< >> $@-t
+ mv $@-t $@
+guestfs_config.ml: ../mllib/guestfs_config.ml
+ cp $< $@
+
CLEANFILES += $(noinst_DATA) $(noinst_PROGRAM)
DISTCLEANFILES += .pod2text.data.version.2
diff --git a/generator/bindtests.ml b/generator/bindtests.ml
index 742cb1b..ffb3ee7 100644
--- a/generator/bindtests.ml
+++ b/generator/bindtests.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -176,7 +177,7 @@ fill_lvm_pv (guestfs_h *g, struct guestfs_lvm_pv *pv, size_t i)
let check_optarg n printf_args =
pr " fprintf (fp, \"%s: \");\n" n;
pr " if (optargs->bitmask & %s_%s_BITMASK) {\n" c_optarg_prefix
- (String.uppercase n);
+ (String.uppercase_ascii n);
pr " fprintf (fp, %s);\n" printf_args;
pr " } else {\n";
pr " fprintf (fp, \"unset\\n\");\n";
@@ -200,7 +201,7 @@ fill_lvm_pv (guestfs_h *g, struct guestfs_lvm_pv *pv, size_t i)
| OStringList n ->
pr " fprintf (fp, \"%s: \");\n" n;
pr " if (optargs->bitmask & %s_%s_BITMASK) {\n" c_optarg_prefix
- (String.uppercase n);
+ (String.uppercase_ascii n);
pr " print_strings (g, optargs->%s);\n" n;
pr " } else {\n";
pr " fprintf (fp, \"unset\\n\");\n";
@@ -583,7 +584,7 @@ public class Bindtests {
| CallBool b -> string_of_bool b
| CallBuffer s ->
"new byte[] { " ^ String.concat "," (
- map_chars (fun c -> string_of_int (Char.code c)) s
+ String.map_chars (fun c -> string_of_int (Char.code c)) s
) ^ " }"
) args
)
@@ -845,7 +846,7 @@ and generate_golang_bindtests () =
generate_lang_bindtests (
fun f args optargs ->
- pr " if err := g.%s (" (String.capitalize f);
+ pr " if err := g.%s (" (String.capitalize_ascii f);
let needs_comma = ref false in
List.iter (
@@ -869,13 +870,13 @@ and generate_golang_bindtests () =
| c -> sprintf "'%c'" c
in
pr "[]byte{%s}"
- (String.concat ", " (List.map quote_char (explode s)))
+ (String.concat ", " (List.map quote_char (String.explode s)))
) args;
if !needs_comma then pr ", ";
(match optargs with
| None -> pr "nil"
| Some optargs ->
- pr "&guestfs.Optargs%s{" (String.capitalize f);
+ pr "&guestfs.Optargs%s{" (String.capitalize_ascii f);
needs_comma := false;
List.iter (
fun optarg ->
@@ -883,19 +884,19 @@ and generate_golang_bindtests () =
needs_comma := true;
match optarg with
| CallOBool (n, v) ->
- let n = String.capitalize n in
+ let n = String.capitalize_ascii n in
pr "%s_is_set: true, %s: %b" n n v
| CallOInt (n, v) ->
- let n = String.capitalize n in
+ let n = String.capitalize_ascii n in
pr "%s_is_set: true, %s: %d" n n v
| CallOInt64 (n, v) ->
- let n = String.capitalize n in
+ let n = String.capitalize_ascii n in
pr "%s_is_set: true, %s: %Ld" n n v
| CallOString (n, v) ->
- let n = String.capitalize n in
+ let n = String.capitalize_ascii n in
pr "%s_is_set: true, %s: \"%s\"" n n v
| CallOStringList (n, xs) ->
- let n = String.capitalize n in
+ let n = String.capitalize_ascii n in
pr "%s_is_set: true, %s: []string{%s}"
n n (String.concat ", " (List.map (sprintf "\"%s\"") xs))
) optargs;
@@ -971,7 +972,7 @@ and generate_php_bindtests () =
let chan = open_in filename in
let rec loop () =
let line = input_line chan in
- (match string_split ":" line with
+ (match String.nsplit ":" line with
| ("obool"|"oint"|"oint64"|"ostring"|"ostringlist") as x :: _ ->
pr "%s: unset\n" x
| _ -> pr "%s\n" line
diff --git a/generator/c.ml b/generator/c.ml
index 6f5a517..79d3811 100644
--- a/generator/c.ml
+++ b/generator/c.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -102,7 +103,7 @@ let rec generate_prototype ?(extern = true) ?(static = false)
else (
let namelen = String.length prefix + String.length name +
String.length suffix + 2 in
- pr ",\n%s%s" indent (spaces namelen)
+ pr ",\n%s%s" indent (String.spaces namelen)
)
);
comma := true
@@ -230,7 +231,8 @@ and generate_actions_pod_entry ({ c_name = c_name;
List.iter (
fun argt ->
let n = name_of_optargt argt in
- pr " GUESTFS_%s_%s, " (String.uppercase c_name) (String.uppercase n);
+ pr " GUESTFS_%s_%s, " (String.uppercase_ascii c_name)
+ (String.uppercase_ascii n);
match argt with
| OBool n -> pr "int %s,\n" n
| OInt n -> pr "int %s,\n" n
@@ -508,7 +510,7 @@ extern GUESTFS_DLL_PUBLIC guestfs_abort_cb guestfs_get_out_of_memory_handler (gu
List.iter (
fun (name, bitmask) ->
pr "#define GUESTFS_EVENT_%-16s 0x%04x\n"
- (String.uppercase name) bitmask
+ (String.uppercase_ascii name) bitmask
) events;
pr "#define GUESTFS_EVENT_%-16s 0x%04x\n" "ALL" all_events_bitmask;
pr "\n";
@@ -601,7 +603,7 @@ extern GUESTFS_DLL_PUBLIC void *guestfs_next_private (guestfs_h *g, const char *
(* Public structures. *)
let generate_all_structs = List.iter (
fun { s_name = typ; s_cols = cols } ->
- pr "#define GUESTFS_HAVE_STRUCT_%s 1\n" (String.uppercase typ);
+ pr "#define GUESTFS_HAVE_STRUCT_%s 1\n" (String.uppercase_ascii typ);
pr "\n";
pr "struct guestfs_%s {\n" typ;
List.iter (
@@ -645,14 +647,14 @@ extern GUESTFS_DLL_PUBLIC void *guestfs_next_private (guestfs_h *g, const char *
let generate_action_header { name = shortname;
style = ret, args, optargs as style;
deprecated_by = deprecated_by } =
- pr "#define GUESTFS_HAVE_%s 1\n" (String.uppercase shortname);
+ pr "#define GUESTFS_HAVE_%s 1\n" (String.uppercase_ascii shortname);
if optargs <> [] then (
iteri (
fun i argt ->
- let uc_shortname = String.uppercase shortname in
+ let uc_shortname = String.uppercase_ascii shortname in
let n = name_of_optargt argt in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr "#define GUESTFS_%s_%s %d\n" uc_shortname uc_n i;
) optargs;
);
@@ -682,9 +684,9 @@ extern GUESTFS_DLL_PUBLIC void *guestfs_next_private (guestfs_h *g, const char *
| OInt64 n -> "int64_t "
| OString n -> "const char *"
| OStringList n -> "char *const *" in
- let uc_shortname = String.uppercase shortname in
+ let uc_shortname = String.uppercase_ascii shortname in
let n = name_of_optargt argt in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr "# define GUESTFS_%s_%s_BITMASK (UINT64_C(1)<<%d)\n" uc_shortname uc_n i;
pr " %s%s;\n" c_type n
) optargs;
@@ -759,7 +761,7 @@ pr "\
List.iter (
fun { name = shortname } ->
- pr "#define LIBGUESTFS_HAVE_%s 1\n" (String.uppercase shortname);
+ pr "#define LIBGUESTFS_HAVE_%s 1\n" (String.uppercase_ascii shortname);
) public_functions_sorted;
pr "
@@ -810,9 +812,9 @@ and generate_internal_frontend_cleanups_h () =
List.iter (
fun { s_name = name } ->
- pr "#define CLEANUP_FREE_%s \\\n" (String.uppercase name);
+ pr "#define CLEANUP_FREE_%s \\\n" (String.uppercase_ascii name);
pr " __attribute__((cleanup(guestfs_int_cleanup_free_%s)))\n" name;
- pr "#define CLEANUP_FREE_%s_LIST \\\n" (String.uppercase name);
+ pr "#define CLEANUP_FREE_%s_LIST \\\n" (String.uppercase_ascii name);
pr " __attribute__((cleanup(guestfs_int_cleanup_free_%s_list)))\n" name
) structs;
@@ -820,8 +822,8 @@ and generate_internal_frontend_cleanups_h () =
List.iter (
fun { s_name = name } ->
- pr "#define CLEANUP_FREE_%s\n" (String.uppercase name);
- pr "#define CLEANUP_FREE_%s_LIST\n" (String.uppercase name)
+ pr "#define CLEANUP_FREE_%s\n" (String.uppercase_ascii name);
+ pr "#define CLEANUP_FREE_%s_LIST\n" (String.uppercase_ascii name)
) structs;
pr "\
@@ -1409,7 +1411,7 @@ and generate_client_actions actions () =
function
| OString n ->
pr " if ((optargs->bitmask & GUESTFS_%s_%s_BITMASK) &&\n"
- (String.uppercase c_name) (String.uppercase n);
+ (String.uppercase_ascii c_name) (String.uppercase_ascii n);
pr " optargs->%s == NULL) {\n" n;
pr " error (g, \"%%s: %%s: optional parameter cannot be NULL\",\n";
pr " \"%s\", \"%s\");\n" c_name n;
@@ -1423,7 +1425,7 @@ and generate_client_actions actions () =
| OStringList n ->
pr " if ((optargs->bitmask & GUESTFS_%s_%s_BITMASK) &&\n"
- (String.uppercase c_name) (String.uppercase n);
+ (String.uppercase_ascii c_name) (String.uppercase_ascii n);
pr " optargs->%s == NULL) {\n" n;
pr " error (g, \"%%s: %%s: optional list cannot be NULL\",\n";
pr " \"%s\", \"%s\");\n" c_name n;
@@ -1587,7 +1589,7 @@ and generate_client_actions actions () =
fun argt ->
let n = name_of_optargt argt in
pr " if (optargs->bitmask & GUESTFS_%s_%s_BITMASK) {\n"
- (String.uppercase c_name) (String.uppercase n);
+ (String.uppercase_ascii c_name) (String.uppercase_ascii n);
(match argt with
| OString n ->
pr " fprintf (trace_buffer.fp, \" \\\"%%s:%%s\\\"\", \"%s\", optargs->%s);\n" n n
@@ -1614,7 +1616,7 @@ and generate_client_actions actions () =
in
let trace_return ?(indent = 2) name (ret, _, _) rv =
- let indent = spaces indent in
+ let indent = String.spaces indent in
pr "%sif (trace_flag) {\n" indent;
@@ -1679,7 +1681,7 @@ and generate_client_actions actions () =
in
let trace_return_error ?(indent = 2) name (ret, _, _) errcode =
- let indent = spaces indent in
+ let indent = String.spaces indent in
pr "%sif (trace_flag)\n" indent;
@@ -1876,7 +1878,7 @@ and generate_client_actions actions () =
(* Send the main header and arguments. *)
if args_passed_to_daemon = [] && optargs = [] then (
pr " serial = guestfs_int_send (g, GUESTFS_PROC_%s, progress_hint, 0,\n"
- (String.uppercase name);
+ (String.uppercase_ascii name);
pr " NULL, NULL);\n"
) else (
List.iter (
@@ -1913,7 +1915,7 @@ and generate_client_actions actions () =
fun argt ->
let n = name_of_optargt argt in
pr " if (optargs->bitmask & GUESTFS_%s_%s_BITMASK) {\n"
- (String.uppercase c_name) (String.uppercase n);
+ (String.uppercase_ascii c_name) (String.uppercase_ascii n);
(match argt with
| OBool n
| OInt n
@@ -1938,7 +1940,7 @@ and generate_client_actions actions () =
) optargs;
pr " serial = guestfs_int_send (g, GUESTFS_PROC_%s,\n"
- (String.uppercase name);
+ (String.uppercase_ascii name);
pr " progress_hint, %s,\n"
(if optargs <> [] then "optargs->bitmask" else "0");
pr " (xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
@@ -1989,7 +1991,7 @@ and generate_client_actions actions () =
pr "\n";
pr " if (guestfs_int_check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
- (String.uppercase name);
+ (String.uppercase_ascii name);
trace_return_error ~indent:4 name style errcode;
pr " return %s;\n" (string_of_errcode errcode);
pr " }\n";
@@ -2160,7 +2162,7 @@ and generate_client_actions_variants () =
fun argt ->
let n = name_of_optargt argt in
pr " case GUESTFS_%s_%s:\n"
- (String.uppercase c_name) (String.uppercase n);
+ (String.uppercase_ascii c_name) (String.uppercase_ascii n);
pr " optargs_s.%s = va_arg (args, " n;
(match argt with
| OBool _ | OInt _ -> pr "int"
@@ -2273,7 +2275,8 @@ guestfs_event_to_string (uint64_t event)
List.iter (
fun name ->
- pr " if ((event & GUESTFS_EVENT_%s) != 0) {\n" (String.uppercase name);
+ pr " if ((event & GUESTFS_EVENT_%s) != 0) {\n"
+ (String.uppercase_ascii name);
pr " strcpy (&ret[len], \"%s,\");\n" name;
pr " len += %d + 1;\n" (String.length name);
pr " }\n";
diff --git a/generator/daemon.ml b/generator/daemon.ml
index ce5dada..f05d5b7 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -49,9 +50,9 @@ let generate_daemon_actions_h () =
| { name = shortname; style = _, _, (_::_ as optargs) } ->
iteri (
fun i arg ->
- let uc_shortname = String.uppercase shortname in
+ let uc_shortname = String.uppercase_ascii shortname in
let n = name_of_optargt arg in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr "#define GUESTFS_%s_%s_BITMASK (UINT64_C(1)<<%d)\n"
uc_shortname uc_n i
) optargs
@@ -541,7 +542,7 @@ let generate_daemon_dispatch () =
List.iter (
fun { name = name } ->
- pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
+ pr " case GUESTFS_PROC_%s:\n" (String.uppercase_ascii name);
pr " %s_stub (xdr_in);\n" name;
pr " break;\n"
) (actions |> daemon_functions);
@@ -819,7 +820,8 @@ let generate_daemon_optgroups_h () =
";
List.iter (
fun (group, fns) ->
- pr "#define OPTGROUP_%s_NOT_AVAILABLE \\\n" (String.uppercase group);
+ pr "#define OPTGROUP_%s_NOT_AVAILABLE \\\n"
+ (String.uppercase_ascii group);
List.iter (
fun { name = name; style = ret, args, optargs } ->
let style = ret, args @ args_of_optargs optargs, [] in
diff --git a/generator/docstrings.ml b/generator/docstrings.ml
index 9d3fd0b..845ec63 100644
--- a/generator/docstrings.ml
+++ b/generator/docstrings.ml
@@ -21,6 +21,7 @@
open Unix
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -41,7 +42,7 @@ let deprecation_notice ?(prefix = "") ?(replace_underscores = false) =
| { deprecated_by = None } -> None
| { deprecated_by = Some alt } ->
let alt =
- if replace_underscores then replace_char alt '_' '-' else alt in
+ if replace_underscores then String.replace_char alt '_' '-' else alt in
let txt =
sprintf "I<This function is deprecated.>
In new code, use the L</%s%s> call instead.
diff --git a/generator/erlang.ml b/generator/erlang.ml
index fab92a0..3753835 100644
--- a/generator/erlang.ml
+++ b/generator/erlang.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -105,7 +106,7 @@ loop(Port) ->
pr "%s(G" name;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
if optargs <> [] then
pr ", Optargs";
@@ -114,7 +115,7 @@ loop(Port) ->
pr " call_port(G, {%s" name;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
if optargs <> [] then
pr ", Optargs";
@@ -128,14 +129,14 @@ loop(Port) ->
pr "%s(G" name;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
pr ") ->\n";
pr " %s(G" name;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
pr ", []";
pr ").\n"
@@ -147,7 +148,7 @@ loop(Port) ->
pr "%s(G" alias;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
if optargs <> [] then
pr ", Optargs";
@@ -156,7 +157,7 @@ loop(Port) ->
pr " %s(G" name;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
if optargs <> [] then
pr ", Optargs";
@@ -166,14 +167,14 @@ loop(Port) ->
pr "%s(G" alias;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
pr ") ->\n";
pr " %s(G" name;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
pr ").\n"
)
@@ -404,7 +405,7 @@ instead of erl_interface.
List.iter (
fun argt ->
let n = name_of_optargt argt in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr " if (atom_equals (hd_name, \"%s\")) {\n" n;
pr " optargs_s.bitmask |= %s_%s_BITMASK;\n"
c_optarg_prefix uc_n;
@@ -457,12 +458,12 @@ instead of erl_interface.
function
| OBool _ | OInt _ | OInt64 _ -> ()
| OString n ->
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr " if ((optargs_s.bitmask & %s_%s_BITMASK))\n"
c_optarg_prefix uc_n;
pr " free ((char *) optargs_s.%s);\n" n
| OStringList n ->
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr " if ((optargs_s.bitmask & %s_%s_BITMASK))\n"
c_optarg_prefix uc_n;
pr " guestfs_int_free_string_list ((char **) optargs_s.%s);\n" n
diff --git a/generator/events.ml b/generator/events.ml
index c92c760..7188e12 100644
--- a/generator/events.ml
+++ b/generator/events.ml
@@ -18,6 +18,7 @@
(* Please read generator/README first. *)
+open Common_utils
open Utils
(* NB: DO NOT REORDER THESE, as doing so will change the ABI. Only
diff --git a/generator/fish.ml b/generator/fish.ml
index 62752e8..9ef7a30 100644
--- a/generator/fish.ml
+++ b/generator/fish.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -53,7 +54,7 @@ let doc_opttype_of = function
let get_aliases { fish_alias = fish_alias; non_c_aliases = non_c_aliases } =
let non_c_aliases =
- List.map (fun n -> replace_char n '_' '-') non_c_aliases in
+ List.map (fun n -> String.replace_char n '_' '-') non_c_aliases in
fish_alias @ non_c_aliases
let all_functions_commands_and_aliases_sorted =
@@ -73,7 +74,7 @@ let all_functions_commands_and_aliases_sorted =
let c_quoted_indented ~indent str =
let str = c_quote str in
- let str = replace_str str "\\n" ("\\n\"\n" ^ indent ^ "\"") in
+ let str = String.replace str "\\n" ("\\n\"\n" ^ indent ^ "\"") in
str
(* Generate run_* functions and header for libguestfs API functions. *)
@@ -322,7 +323,7 @@ let generate_fish_run_cmds actions () =
List.iter (
fun argt ->
let n = name_of_optargt argt in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
let len = String.length n in
pr "if (STRPREFIX (argv[i], \"%s:\")) {\n" n;
(match argt with
@@ -466,7 +467,7 @@ let generate_fish_run_cmds actions () =
List.iter (
function
| OStringList n ->
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr " if ((optargs_s.bitmask & %s_%s_BITMASK) &&\n"
c_optarg_prefix uc_n;
pr " optargs_s.%s != NULL)\n" n;
@@ -539,9 +540,9 @@ let generate_fish_cmd_entries actions () =
shortdesc = shortdesc; longdesc = longdesc } as f) ->
let aliases = get_aliases f in
- let name2 = replace_char name '_' '-' in
+ let name2 = String.replace_char name '_' '-' in
- let longdesc = replace_str longdesc "C<guestfs_" "C<" in
+ let longdesc = String.replace longdesc "C<guestfs_" "C<" in
let synopsis =
match args with
| [] -> name2
@@ -625,7 +626,7 @@ let generate_fish_cmds () =
fun ({ name = name; shortdesc = shortdesc; longdesc = longdesc } as f) ->
let aliases = get_aliases f in
- let name2 = replace_char name '_' '-' in
+ let name2 = String.replace_char name '_' '-' in
let describe_alias =
if aliases <> [] then
sprintf "\n\nYou can use %s as an alias for this command."
@@ -656,13 +657,13 @@ let generate_fish_cmds () =
pr " list_builtin_commands ();\n";
List.iter (
fun (name, f) ->
- let name = replace_char name '_' '-' in
+ let name = String.replace_char name '_' '-' in
match f with
| Function shortdesc ->
pr " printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
name shortdesc
| Alias f ->
- let f = replace_char f '_' '-' in
+ let f = String.replace_char f '_' '-' in
pr " printf (\"%%-20s \", \"%s\");\n" name;
pr " printf (_(\"alias for '%%s'\"), \"%s\");\n" f;
pr " putchar ('\\n');\n"
@@ -771,7 +772,7 @@ struct command_table;
List.iter (
fun ({ name = name } as f) ->
let aliases = get_aliases f in
- let name2 = replace_char name '_' '-' in
+ let name2 = String.replace_char name '_' '-' in
(* The basic command. *)
pr "%s, &%s_cmd_entry\n" name name;
@@ -817,7 +818,7 @@ static const char *const commands[] = {
List.map (
fun ({ name = name } as f) ->
let aliases = get_aliases f in
- let name2 = replace_char name '_' '-' in
+ let name2 = String.replace_char name '_' '-' in
name2 :: aliases
) (fish_functions_and_commands_sorted) in
let commands = List.flatten commands in
@@ -894,9 +895,9 @@ and generate_fish_actions_pod () =
try Str.matched_group 1 s
with Not_found ->
failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
- "L</" ^ replace_char sub '_' '-' ^ ">"
+ "L</" ^ String.replace_char sub '_' '-' ^ ">"
) longdesc in
- let name = replace_char name '_' '-' in
+ let name = String.replace_char name '_' '-' in
List.iter (
fun name ->
@@ -961,7 +962,7 @@ and generate_fish_commands_pod () =
List.iter (
fun ({ name = name; longdesc = longdesc } as f) ->
let aliases = get_aliases f in
- let name = replace_char name '_' '-' in
+ let name = String.replace_char name '_' '-' in
List.iter (
fun name ->
@@ -1127,7 +1128,8 @@ event_bitmask_of_event_set (const char *arg, uint64_t *eventset_r)
List.iter (
fun (name, _) ->
pr "if (STREQLEN (arg, \"%s\", n))\n" name;
- pr " *eventset_r |= GUESTFS_EVENT_%s;\n" (String.uppercase name);
+ pr " *eventset_r |= GUESTFS_EVENT_%s;\n"
+ (String.uppercase_ascii name);
pr " else ";
) events;
@@ -1166,7 +1168,7 @@ $VG guestfish \\
fun i (name, _, _, _) ->
let params = [name] in
let params =
- if find name "lv" <> -1 then (
+ if String.find name "lv" <> -1 then (
incr vg_count;
sprintf "/dev/VG%d/LV" !vg_count :: params
) else params in
diff --git a/generator/gobject.ml b/generator/gobject.ml
index 7ee73a6..e14ea20 100644
--- a/generator/gobject.ml
+++ b/generator/gobject.ml
@@ -22,6 +22,7 @@
open Printf
+open Common_utils
open Actions
open Docstrings
open Events
@@ -125,7 +126,7 @@ let filenames =
let header_start filename =
generate_header CStyle GPLv2plus;
let guard = Str.global_replace (Str.regexp "-") "_" filename in
- let guard = "GUESTFS_GOBJECT_" ^ String.uppercase guard ^ "_H__" in
+ let guard = "GUESTFS_GOBJECT_" ^ String.uppercase_ascii guard ^ "_H__" in
pr "#ifndef %s\n" guard;
pr "#define %s\n" guard;
pr "
@@ -139,7 +140,7 @@ G_BEGIN_DECLS
and header_end filename =
let guard = Str.global_replace (Str.regexp "-") "_" filename in
- let guard = "GUESTFS_GOBJECT_" ^ String.uppercase guard ^ "_H__" in
+ let guard = "GUESTFS_GOBJECT_" ^ String.uppercase_ascii guard ^ "_H__" in
pr "
G_END_DECLS
@@ -299,7 +300,7 @@ let generate_gobject_struct_source filename typ () =
let generate_gobject_optargs_header filename name f () =
header_start filename;
- let uc_name = String.uppercase name in
+ let uc_name = String.uppercase_ascii name in
let camel_name = camel_of_name f in
let type_define = "GUESTFS_TYPE_" ^ uc_name in
@@ -358,7 +359,7 @@ let generate_gobject_optargs_source filename name optargs f () =
"An object encapsulating optional arguments for guestfs_session_" ^ name in
source_start ~shortdesc:desc ~longdesc:desc filename;
- let uc_name = String.uppercase name in
+ let uc_name = String.uppercase_ascii name in
let camel_name = camel_of_name f in
let type_define = "GUESTFS_TYPE_" ^ uc_name in
@@ -386,7 +387,7 @@ let generate_gobject_optargs_source filename name optargs f () =
pr " PROP_GUESTFS_%s_PROP0" uc_name;
List.iter (
fun optargt ->
- let uc_optname = String.uppercase (name_of_optargt optargt) in
+ let uc_optname = String.uppercase_ascii (name_of_optargt optargt) in
pr ",\n PROP_GUESTFS_%s_%s" uc_name uc_optname;
) optargs;
pr "\n};\n\n";
@@ -402,7 +403,7 @@ let generate_gobject_optargs_source filename name optargs f () =
function OStringList _ -> () (* XXX *)
| optargt ->
let optname = name_of_optargt optargt in
- let uc_optname = String.uppercase optname in
+ let uc_optname = String.uppercase_ascii optname in
pr " case PROP_GUESTFS_%s_%s:\n" uc_name uc_optname;
(match optargt with
| OString n ->
@@ -435,7 +436,7 @@ let generate_gobject_optargs_source filename name optargs f () =
function OStringList _ -> () (* XXX *)
| optargt ->
let optname = name_of_optargt optargt in
- let uc_optname = String.uppercase optname in
+ let uc_optname = String.uppercase_ascii optname in
pr " case PROP_GUESTFS_%s_%s:\n" uc_name uc_optname;
let set_value_func = match optargt with
| OBool _ -> "enum"
@@ -508,7 +509,7 @@ let generate_gobject_optargs_source filename name optargs f () =
pr " */\n";
pr " g_object_class_install_property (\n";
pr " object_class,\n";
- pr " PROP_GUESTFS_%s_%s,\n" uc_name (String.uppercase optname);
+ pr " PROP_GUESTFS_%s_%s,\n" uc_name (String.uppercase_ascii optname);
pr " g_param_spec_%s (\n" type_spec;
pr " \"%s\",\n" optname;
pr " \"%s\",\n" optname;
@@ -607,7 +608,7 @@ let generate_gobject_session_header () =
List.iter (
fun (name, _) ->
pr " * @GUESTFS_SESSION_EVENT_%s: The %s event\n"
- (String.uppercase name) name;
+ (String.uppercase_ascii name) name;
) events;
pr " *
@@ -618,7 +619,7 @@ typedef enum {";
List.iter (
fun (name, _) ->
- pr "\n GUESTFS_SESSION_EVENT_%s," (String.uppercase name);
+ pr "\n GUESTFS_SESSION_EVENT_%s," (String.uppercase_ascii name);
) events;
pr "
@@ -776,8 +777,8 @@ guestfs_session_event_from_guestfs_event (uint64_t event)
List.iter (
fun (name, _) ->
- let enum_name = "GUESTFS_SESSION_EVENT_" ^ String.uppercase name in
- let guestfs_name = "GUESTFS_EVENT_" ^ String.uppercase name in
+ let enum_name = "GUESTFS_SESSION_EVENT_" ^ String.uppercase_ascii name in
+ let guestfs_name = "GUESTFS_EVENT_" ^ String.uppercase_ascii name in
pr "\n case %s: return %s;" guestfs_name enum_name;
) events;
@@ -830,7 +831,7 @@ guestfs_session_event_get_type (void)
List.iter (
fun (name, _) ->
- let enum_name = "GUESTFS_SESSION_EVENT_" ^ String.uppercase name in
+ let enum_name = "GUESTFS_SESSION_EVENT_" ^ String.uppercase_ascii name in
pr "\n { %s, \"%s\", \"%s\" }," enum_name enum_name name
) events;
@@ -887,7 +888,8 @@ guestfs_session_class_init (GuestfsSessionClass *klass)
pr " * See \"SETTING CALLBACKS TO HANDLE EVENTS\" in guestfs(3) for\n";
pr " * more details about this event.\n";
pr " */\n";
- pr " signals[GUESTFS_SESSION_EVENT_%s] =\n" (String.uppercase name);
+ pr " signals[GUESTFS_SESSION_EVENT_%s] =\n"
+ (String.uppercase_ascii name);
pr " g_signal_new (g_intern_static_string (\"%s\"),\n" name;
pr " G_OBJECT_CLASS_TYPE (object_class),\n";
pr " G_SIGNAL_RUN_LAST,\n";
@@ -1156,7 +1158,7 @@ guestfs_session_close (GuestfsSession *session, GError **err)
pr " if (optargs) {\n";
pr " argv.bitmask = 0;\n\n";
let set_property name typ v_typ get_typ unset =
- let uc_name = String.uppercase name in
+ let uc_name = String.uppercase_ascii name in
pr " GValue %s_v = {0, };\n" name;
pr " g_value_init (&%s_v, %s);\n" name v_typ;
pr " g_object_get_property (G_OBJECT (optargs), \"%s\", &%s_v);\n" name name;
diff --git a/generator/java.ml b/generator/java.ml
index 260e28c..a68054c 100644
--- a/generator/java.ml
+++ b/generator/java.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -156,7 +157,8 @@ public class GuestFS {
pr " *\n";
pr " * @see #set_event_callback\n";
pr " */\n";
- pr " public static final long EVENT_%s = 0x%x;\n" (String.uppercase name) bitmask;
+ pr " public static final long EVENT_%s = 0x%x;\n"
+ (String.uppercase_ascii name) bitmask;
pr "\n";
) events;
@@ -259,7 +261,7 @@ public class GuestFS {
let ret, args, optargs = f.style in
if is_documented f then (
- let doc = replace_str f.longdesc "C<guestfs_" "C<g." in
+ let doc = String.replace f.longdesc "C<guestfs_" "C<g." in
let doc =
if optargs <> [] then
doc ^ "\n\nOptional arguments are supplied in the final Map<String,Object> parameter, which is a hash of the argument name to its value (cast to Object). Pass an empty Map or null for no optional arguments."
@@ -625,7 +627,7 @@ throw_out_of_memory (JNIEnv *env, const char *msg)
);
pr "JNICALL\n";
pr "Java_com_redhat_et_libguestfs_GuestFS_";
- pr "%s" (replace_str ("_" ^ name) "_" "_1");
+ pr "%s" (String.replace ("_" ^ name) "_" "_1");
pr " (JNIEnv *env, jobject obj, jlong jg";
List.iter (
function
diff --git a/generator/lua.ml b/generator/lua.ml
index d3b0b27..e48bb3e 100644
--- a/generator/lua.ml
+++ b/generator/lua.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -529,7 +530,7 @@ guestfs_int_lua_delete_event_callback (lua_State *L)
List.iter (
fun optarg ->
let n = name_of_optargt optarg in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr " OPTARG_IF_SET (%d, \"%s\",\n" optarg_index n;
pr " optargs_s.bitmask |= %s_%s_BITMASK;\n"
c_optarg_prefix uc_n;
diff --git a/generator/ocaml.ml b/generator/ocaml.ml
index f76a3ab..5a85d38 100644
--- a/generator/ocaml.ml
+++ b/generator/ocaml.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -98,7 +99,7 @@ type event =
";
List.iter (
fun (name, _) ->
- pr " | EVENT_%s\n" (String.uppercase name)
+ pr " | EVENT_%s\n" (String.uppercase_ascii name)
) events;
pr "\n";
@@ -310,7 +311,7 @@ type event =
";
List.iter (
fun (name, _) ->
- pr " | EVENT_%s\n" (String.uppercase name)
+ pr " | EVENT_%s\n" (String.uppercase_ascii name)
) events;
pr "\n";
@@ -319,7 +320,7 @@ let event_all = [
";
List.iter (
fun (name, _) ->
- pr " EVENT_%s;\n" (String.uppercase name)
+ pr " EVENT_%s;\n" (String.uppercase_ascii name)
) events;
pr "\
@@ -342,7 +343,7 @@ module Errno = struct
";
List.iter (
fun e ->
- let le = String.lowercase e in
+ let le = String.lowercase_ascii e in
pr " external %s : unit -> int = \"guestfs_int_ocaml_get_%s\" \"noalloc\"\n"
le e;
pr " let errno_%s = %s ()\n" e le
@@ -637,7 +638,7 @@ copy_table (char * const * argv)
List.iter (
fun argt ->
let n = name_of_optargt argt in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr " if (%sv != Val_int (0)) {\n" n;
pr " optargs_s.bitmask |= %s_%s_BITMASK;\n" c_optarg_prefix uc_n;
(match argt with
diff --git a/generator/perl.ml b/generator/perl.ml
index 94d7c4f..290b687 100644
--- a/generator/perl.ml
+++ b/generator/perl.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -455,7 +456,7 @@ PREINIT:
List.iter (
fun argt ->
let n = name_of_optargt argt in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr "if (STREQ (this_arg, \"%s\")) {\n" n;
(match argt with
| OBool _
@@ -787,14 +788,14 @@ when the final reference is cleaned up is OK).
List.iter (
fun (name, bitmask) ->
- pr "=item $Sys::Guestfs::EVENT_%s\n" (String.uppercase name);
+ pr "=item $Sys::Guestfs::EVENT_%s\n" (String.uppercase_ascii name);
pr "\n";
pr "See L<guestfs(3)/GUESTFS_EVENT_%s>.\n"
- (String.uppercase name);
+ (String.uppercase_ascii name);
pr "\n";
pr "=cut\n";
pr "\n";
- pr "our $EVENT_%s = 0x%x;\n" (String.uppercase name) bitmask;
+ pr "our $EVENT_%s = 0x%x;\n" (String.uppercase_ascii name) bitmask;
pr "\n"
) events;
@@ -888,7 +889,7 @@ errnos:
List.iter (
fun ({ name = name; style = style;
longdesc = longdesc; non_c_aliases = non_c_aliases } as f) ->
- let longdesc = replace_str longdesc "C<guestfs_" "C<$g-E<gt>" in
+ let longdesc = String.replace longdesc "C<guestfs_" "C<$g-E<gt>" in
pr "=item ";
generate_perl_prototype name style;
pr "\n\n";
diff --git a/generator/pr.ml b/generator/pr.ml
index 616e6f9..666cd41 100644
--- a/generator/pr.ml
+++ b/generator/pr.ml
@@ -21,6 +21,7 @@
open Unix
open Printf
+open Common_utils
open Utils
(* Output channel, 'pr' prints to this. *)
@@ -39,7 +40,7 @@ let fileshash = Hashtbl.create 13
let pr fs =
ksprintf
(fun str ->
- let i = count_chars '\n' str in
+ let i = String.count_chars '\n' str in
lines := !lines + i;
output_string !chan str
) fs
diff --git a/generator/python.ml b/generator/python.ml
index 281fb0a..1e24a59 100644
--- a/generator/python.ml
+++ b/generator/python.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -94,14 +95,14 @@ extern PyObject *guestfs_int_py_put_table (char * const * const argv);
";
let emit_put_list_decl typ =
- pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase typ);
+ pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase_ascii typ);
pr "extern PyObject *guestfs_int_py_put_%s_list (struct guestfs_%s_list *%ss);\n" typ typ typ;
pr "#endif\n";
in
List.iter (
fun { s_name = typ } ->
- pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase typ);
+ pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase_ascii typ);
pr "extern PyObject *guestfs_int_py_put_%s (struct guestfs_%s *%s);\n" typ typ typ;
pr "#endif\n";
) external_structs;
@@ -118,7 +119,7 @@ extern PyObject *guestfs_int_py_put_table (char * const * const argv);
List.iter (
fun { name = name; c_name = c_name } ->
- pr "#ifdef GUESTFS_HAVE_%s\n" (String.uppercase c_name);
+ pr "#ifdef GUESTFS_HAVE_%s\n" (String.uppercase_ascii c_name);
pr "extern PyObject *guestfs_int_py_%s (PyObject *self, PyObject *args);\n" name;
pr "#endif\n"
) (actions |> external_functions |> sort);
@@ -147,7 +148,7 @@ and generate_python_structs () =
";
let emit_put_list_function typ =
- pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase typ);
+ pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase_ascii typ);
pr "PyObject *\n";
pr "guestfs_int_py_put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
pr "{\n";
@@ -166,7 +167,7 @@ and generate_python_structs () =
(* Structures, turned into Python dictionaries. *)
List.iter (
fun { s_name = typ; s_cols = cols } ->
- pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase typ);
+ pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase_ascii typ);
pr "PyObject *\n";
pr "guestfs_int_py_put_%s (struct guestfs_%s *%s)\n" typ typ typ;
pr "{\n";
@@ -279,7 +280,7 @@ and generate_python_actions actions () =
blocking = blocking;
c_name = c_name;
c_function = c_function; c_optarg_prefix = c_optarg_prefix } ->
- pr "#ifdef GUESTFS_HAVE_%s\n" (String.uppercase c_name);
+ pr "#ifdef GUESTFS_HAVE_%s\n" (String.uppercase_ascii c_name);
pr "PyObject *\n";
pr "guestfs_int_py_%s (PyObject *self, PyObject *args)\n" name;
pr "{\n";
@@ -415,7 +416,7 @@ and generate_python_actions actions () =
List.iter (
fun optarg ->
let n = name_of_optargt optarg in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr "#ifdef %s_%s_BITMASK\n" c_optarg_prefix uc_n;
pr " if (py_%s != Py_None) {\n" n;
pr " optargs_s.bitmask |= %s_%s_BITMASK;\n" c_optarg_prefix uc_n;
@@ -560,7 +561,7 @@ and generate_python_actions actions () =
function
| OBool _ | OInt _ | OInt64 _ | OString _ -> ()
| OStringList n ->
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr "#ifdef %s_%s_BITMASK\n" c_optarg_prefix uc_n;
pr " if (py_%s != Py_None && (optargs_s.bitmask & %s_%s_BITMASK) != 0)\n"
n c_optarg_prefix uc_n;
@@ -606,7 +607,7 @@ and generate_python_module () =
pr " guestfs_int_py_event_to_string, METH_VARARGS, NULL },\n";
List.iter (
fun { name = name; c_name = c_name } ->
- pr "#ifdef GUESTFS_HAVE_%s\n" (String.uppercase c_name);
+ pr "#ifdef GUESTFS_HAVE_%s\n" (String.uppercase_ascii c_name);
pr " { (char *) \"%s\", guestfs_int_py_%s, METH_VARARGS, NULL },\n"
name name;
pr "#endif\n"
@@ -732,7 +733,7 @@ import libguestfsmod
List.iter (
fun (name, bitmask) ->
- pr "EVENT_%s = 0x%x\n" (String.uppercase name) bitmask
+ pr "EVENT_%s = 0x%x\n" (String.uppercase_ascii name) bitmask
) events;
pr "EVENT_ALL = 0x%x\n" all_events_bitmask;
pr "\n";
@@ -855,7 +856,7 @@ class GuestFS(object):
f.name (indent_python decl_string (9 + len_name) 78);
if is_documented f then (
- let doc = replace_str f.longdesc "C<guestfs_" "C<g." in
+ let doc = String.replace f.longdesc "C<guestfs_" "C<g." in
let doc =
match ret with
| RErr | RInt _ | RInt64 _ | RBool _
@@ -883,7 +884,7 @@ class GuestFS(object):
| Some opt ->
doc ^ sprintf "\n\nThis function depends on the feature C<%s>. See also C<g.feature-available>." opt in
let doc = pod2text ~width:60 f.name doc in
- let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
+ let doc = List.map (fun line -> String.replace line "\\" "\\\\") doc in
let doc =
match doc with
| [] -> ""
diff --git a/generator/ruby.ml b/generator/ruby.ml
index 74d206f..0b7cbed 100644
--- a/generator/ruby.ml
+++ b/generator/ruby.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -127,7 +128,7 @@ and generate_ruby_c actions () =
(* Generate rdoc. *)
if is_documented f then (
- let doc = replace_str f.longdesc "C<guestfs_" "C<g." in
+ let doc = String.replace f.longdesc "C<guestfs_" "C<g." in
let doc =
if optargs <> [] then
doc ^ "\n\nOptional arguments are supplied in the final hash parameter, which is a hash of the argument name to its value. Pass an empty {} for no optional arguments."
@@ -138,7 +139,7 @@ and generate_ruby_c actions () =
else doc in
let doc = pod2text ~width:60 f.name doc in
let doc = String.concat "\n * " doc in
- let doc = trim doc in
+ let doc = String.trim doc in
let doc =
match version_added f with
| None -> doc
@@ -157,7 +158,7 @@ and generate_ruby_c actions () =
(* Because Ruby documentation appears as C comments, we must
* replace any instance of "/*".
*)
- let doc = replace_str doc "/*" "/ *" in
+ let doc = String.replace doc "/*" "/ *" in
let args = List.map name_of_argt args in
let args = if optargs <> [] then args @ ["{optargs...}"] else args in
@@ -295,7 +296,7 @@ and generate_ruby_c actions () =
List.iter (
fun argt ->
let n = name_of_optargt argt in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr " v = rb_hash_lookup (optargsv, ID2SYM (rb_intern (\"%s\")));\n" n;
pr " if (v != Qnil) {\n";
(match argt with
@@ -483,7 +484,7 @@ Init__guestfs (void)
List.iter (
fun (name, bitmask) ->
pr " rb_define_const (m_guestfs, \"EVENT_%s\",\n"
- (String.uppercase name);
+ (String.uppercase_ascii name);
pr " ULL2NUM (UINT64_C (0x%x)));\n" bitmask;
) events;
pr " rb_define_const (m_guestfs, \"EVENT_ALL\",\n";
diff --git a/generator/tests_c_api.ml b/generator/tests_c_api.ml
index 21ef6e3..8b98927 100644
--- a/generator/tests_c_api.ml
+++ b/generator/tests_c_api.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -201,7 +202,9 @@ static int
return 0;
}
-" test_name name (String.uppercase test_name) (String.uppercase name);
+" test_name name
+ (String.uppercase_ascii test_name)
+ (String.uppercase_ascii name);
if not_disabled then (
generate_test_perform name i test_name test;
@@ -441,7 +444,7 @@ and generate_test_command_call ?(expect_error = false) ?(do_return = true) ?test
| StringList _, arg, sym
| DeviceList _, arg, sym
| FilenameList _, arg, sym ->
- let strs = string_split " " arg in
+ let strs = String.nsplit " " arg in
iteri (
fun i str ->
pr " const char *%s_%d = \"%s\";\n" sym i (c_quote str);
@@ -489,7 +492,7 @@ and generate_test_command_call ?(expect_error = false) ?(do_return = true) ?test
| OStringList n, "" ->
pr " const char *const %s[1] = { NULL };\n" n; true
| OStringList n, arg ->
- let strs = string_split " " arg in
+ let strs = String.nsplit " " arg in
iteri (
fun i str ->
pr " const char *%s_%d = \"%s\";\n" n i (c_quote str);
@@ -519,10 +522,10 @@ and generate_test_command_call ?(expect_error = false) ?(do_return = true) ?test
pr " CLEANUP_FREE_STRING_LIST char **%s;\n" ret;
| RStruct (_, typ) ->
pr " CLEANUP_FREE_%s struct guestfs_%s *%s;\n"
- (String.uppercase typ) typ ret
+ (String.uppercase_ascii typ) typ ret
| RStructList (_, typ) ->
pr " CLEANUP_FREE_%s_LIST struct guestfs_%s_list *%s;\n"
- (String.uppercase typ) typ ret
+ (String.uppercase_ascii typ) typ ret
| RBufferOut _ ->
pr " CLEANUP_FREE char *%s;\n" ret;
pr " size_t size;\n"
diff --git a/generator/uefi.ml b/generator/uefi.ml
index 88e54b8..80b8739 100644
--- a/generator/uefi.ml
+++ b/generator/uefi.ml
@@ -18,6 +18,7 @@
(* Please read generator/README first. *)
+open Common_utils
open Utils
open Pr
open Docstrings
diff --git a/generator/utils.ml b/generator/utils.ml
index 3e81433..ba5e045 100644
--- a/generator/utils.ml
+++ b/generator/utils.ml
@@ -23,6 +23,8 @@
* makes this a bit harder than it should be.
*)
+open Common_utils
+
open Unix
open Printf
@@ -119,85 +121,6 @@ let rstructs_used_by functions =
let failwithf fs = ksprintf failwith fs
-let unique = let i = ref 0 in fun () -> incr i; !i
-
-let replace_char s c1 c2 =
- let b2 = Bytes.of_string s in
- let r = ref false in
- for i = 0 to Bytes.length b2 - 1 do
- if Bytes.unsafe_get b2 i = c1 then (
- Bytes.unsafe_set b2 i c2;
- r := true
- )
- done;
- if not !r then s else Bytes.to_string b2
-
-let isspace c =
- c = ' '
- (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
-
-let triml ?(test = isspace) str =
- let i = ref 0 in
- let n = ref (String.length str) in
- while !n > 0 && test str.[!i]; do
- decr n;
- incr i
- done;
- if !i = 0 then str
- else String.sub str !i !n
-
-let trimr ?(test = isspace) str =
- let n = ref (String.length str) in
- while !n > 0 && test str.[!n-1]; do
- decr n
- done;
- if !n = String.length str then str
- else String.sub str 0 !n
-
-let trim ?(test = isspace) str =
- trimr ~test (triml ~test str)
-
-let rec find s sub =
- let len = String.length s in
- let sublen = String.length sub in
- let rec loop i =
- if i <= len-sublen then (
- let rec loop2 j =
- if j < sublen then (
- if s.[i+j] = sub.[j] then loop2 (j+1)
- else -1
- ) else
- i (* found *)
- in
- let r = loop2 0 in
- if r = -1 then loop (i+1) else r
- ) else
- -1 (* not found *)
- in
- loop 0
-
-let rec replace_str s s1 s2 =
- let len = String.length s in
- let sublen = String.length s1 in
- let i = find s s1 in
- if i = -1 then s
- else (
- let s' = String.sub s 0 i in
- let s'' = String.sub s (i+sublen) (len-i-sublen) in
- s' ^ s2 ^ replace_str s'' s1 s2
- )
-
-let rec string_split sep str =
- let len = String.length str in
- let seplen = String.length sep in
- let i = find str sep in
- if i = -1 then [str]
- else (
- let s' = String.sub str 0 i in
- let s'' = String.sub str (i+seplen) (len-i-seplen) in
- s' :: string_split sep s''
- )
-
let files_equal n1 n2 =
let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
match Sys.command cmd with
@@ -205,70 +128,6 @@ let files_equal n1 n2 =
| 1 -> false
| i -> failwithf "%s: failed with error code %d" cmd i
-let (|>) x f = f x
-
-let rec filter_map f = function
- | [] -> []
- | x :: xs ->
- match f x with
- | Some y -> y :: filter_map f xs
- | None -> filter_map f xs
-
-let rec find_map f = function
- | [] -> raise Not_found
- | x :: xs ->
- match f x with
- | Some y -> y
- | None -> find_map f xs
-
-let iteri f xs =
- let rec loop i = function
- | [] -> ()
- | x :: xs -> f i x; loop (i+1) xs
- in
- loop 0 xs
-
-let mapi f xs =
- let rec loop i = function
- | [] -> []
- | x :: xs -> let r = f i x in r :: loop (i+1) xs
- in
- loop 0 xs
-
-let uniq ?(cmp = Pervasives.compare) xs =
- let rec loop acc = function
- | [] -> acc
- | [x] -> x :: acc
- | x :: (y :: _ as xs) when cmp x y = 0 ->
- loop acc xs
- | x :: (y :: _ as xs) ->
- loop (x :: acc) xs
- in
- List.rev (loop [] xs)
-
-let sort_uniq ?(cmp = Pervasives.compare) xs =
- let xs = List.sort cmp xs in
- let xs = uniq ~cmp xs in
- xs
-
-let count_chars c str =
- let count = ref 0 in
- for i = 0 to String.length str - 1 do
- if c = String.unsafe_get str i then incr count
- done;
- !count
-
-let explode str =
- let r = ref [] in
- for i = 0 to String.length str - 1 do
- let c = String.unsafe_get str i in
- r := c :: !r;
- done;
- List.rev !r
-
-let map_chars f str =
- List.map f (explode str)
-
let name_of_argt = function
| Pathname n | Device n | Mountable n | Dev_or_Path n
| Mountable_or_Path n | String n | OptString n
@@ -290,14 +149,20 @@ let seq_of_test = function
| TestRunOrUnsupported s -> s
let c_quote str =
- let str = replace_str str "\\" "\\\\" in
- let str = replace_str str "\r" "\\r" in
- let str = replace_str str "\n" "\\n" in
- let str = replace_str str "\t" "\\t" in
- let str = replace_str str "\000" "\\0" in
- let str = replace_str str "\"" "\\\"" in
+ let str = String.replace str "\\" "\\\\" in
+ let str = String.replace str "\r" "\\r" in
+ let str = String.replace str "\n" "\\n" in
+ let str = String.replace str "\t" "\\t" in
+ let str = String.replace str "\000" "\\0" in
+ let str = String.replace str "\"" "\\\"" in
str
+let html_escape text =
+ let text = String.replace text "&" "&" in
+ let text = String.replace text "<" "<" in
+ let text = String.replace text ">" ">" in
+ text
+
(* Used to memoize the result of pod2text. *)
type memo_key = int option * bool * bool * string * string
(* width, trim, discard, name, longdesc *)
@@ -356,7 +221,7 @@ let pod2text ?width ?(trim = true) ?(discard = true) name longdesc =
if i = 1 && discard then (* discard the first line of output *)
loop (i+1)
else (
- let line = if trim then triml line else line in
+ let line = if trim then String.triml line else line in
lines := line :: !lines;
loop (i+1)
) in
@@ -376,8 +241,6 @@ let pod2text ?width ?(trim = true) ?(discard = true) name longdesc =
(* Compare two actions (for sorting). *)
let action_compare { name = n1 } { name = n2 } = compare n1 n2
-let spaces n = String.make n ' '
-
let args_of_optargs optargs =
List.map (
function
@@ -387,9 +250,3 @@ let args_of_optargs optargs =
| OString n -> String n
| OStringList n -> StringList n
) optargs
-
-let html_escape text =
- let text = replace_str text "&" "&" in
- let text = replace_str text "<" "<" in
- let text = replace_str text ">" ">" in
- text
diff --git a/generator/utils.mli b/generator/utils.mli
index c7d3f2c..ae6f239 100644
--- a/generator/utils.mli
+++ b/generator/utils.mli
@@ -44,65 +44,10 @@ val rstructs_used_by : Types.action list -> (string * rstructs_used_t) list
val failwithf : ('a, unit, string, 'b) format4 -> 'a
(** Like [failwith] but supports printf-like arguments. *)
-val unique : unit -> int
-(** Returns a unique number each time called. *)
-
-val replace_char : string -> char -> char -> string
-(** Replace character in string. *)
-
-val isspace : char -> bool
-(** Return true if char is a whitespace character. *)
-
-val triml : ?test:(char -> bool) -> string -> string
-(** Trim left. *)
-
-val trimr : ?test:(char -> bool) -> string -> string
-(** Trim right. *)
-
-val trim : ?test:(char -> bool) -> string -> string
-(** Trim left and right. *)
-
-val find : string -> string -> int
-(** [find str sub] searches for [sub] in [str], returning the index
- or -1 if not found. *)
-
-val replace_str : string -> string -> string -> string
-(** [replace_str str s1 s2] replaces [s1] with [s2] throughout [str]. *)
-
-val string_split : string -> string -> string list
-(** [string_split sep str] splits [str] at [sep]. *)
-
val files_equal : string -> string -> bool
(** [files_equal filename1 filename2] returns true if the files contain
the same content. *)
-val (|>) : 'a -> ('a -> 'b) -> 'b
-(** Added in OCaml 4.01, we can remove our definition when we
- can assume this minimum version of OCaml. *)
-
-val filter_map : ('a -> 'b option) -> 'a list -> 'b list
-
-val find_map : ('a -> 'b option) -> 'a list -> 'b
-
-val iteri : (int -> 'a -> unit) -> 'a list -> unit
-
-val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
-
-val uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list
-(** Uniquify a list (the list must be sorted first). *)
-
-val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list
-(** Sort and uniquify a list. *)
-
-val count_chars : char -> string -> int
-(** Count number of times the character occurs in string. *)
-
-val explode : string -> char list
-(** Explode a string into a list of characters. *)
-
-val map_chars : (char -> 'a) -> string -> 'a list
-(** Explode string, then map function over the characters. *)
-
val name_of_argt : Types.argt -> string
(** Extract argument name. *)
@@ -115,6 +60,9 @@ val seq_of_test : Types.c_api_test -> Types.seq
val c_quote : string -> string
(** Perform quoting on a string so it is safe to include in a C source file. *)
+val html_escape : string -> string
+(** Escape a text for HTML display. *)
+
val pod2text : ?width:int -> ?trim:bool -> ?discard:bool -> string -> string -> string list
(** [pod2text ?width ?trim ?discard name longdesc] converts the POD in
[longdesc] to plain ASCII lines of text.
@@ -133,11 +81,5 @@ val pod2text : ?width:int -> ?trim:bool -> ?discard:bool -> string -> string ->
val action_compare : Types.action -> Types.action -> int
(** Compare the names of two actions, for sorting. *)
-val spaces : int -> string
-(** [spaces n] creates a string of n spaces. *)
-
val args_of_optargs : Types.optargs -> Types.args
(** Convert a list of optargs into an equivalent list of args *)
-
-val html_escape : string -> string
-(** Escape a text for HTML display. *)
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 78618f5..e1d1ab8 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -16,7 +16,13 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
+(* The parts between <stdlib>..</stdlib> are copied into the
+ * generator/common_utils.ml file. These parts must ONLY use
+ * functions from the OCaml stdlib.
+ *)
+(*<stdlib>*)
open Printf
+(*</stdlib>*)
open Common_gettext.Gettext
open Getopt.OptionName
@@ -25,6 +31,8 @@ external c_inspect_decrypt : Guestfs.t -> int64 -> unit = "guestfs_int_mllib_ins
external c_set_echo_keys : unit -> unit = "guestfs_int_mllib_set_echo_keys" "noalloc"
external c_set_keys_from_stdin : unit -> unit = "guestfs_int_mllib_set_keys_from_stdin" "noalloc"
+(*<stdlib>*)
+
module Char = struct
include Char
@@ -37,6 +45,20 @@ module Char = struct
if (c >= 'a' && c <= 'z')
then unsafe_chr (code c - 32)
else c
+
+ let isspace c =
+ c = ' '
+ (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
+
+ let isdigit = function
+ | '0'..'9' -> true
+ | _ -> false
+
+ let isxdigit = function
+ | '0'..'9' -> true
+ | 'a'..'f' -> true
+ | 'A'..'F' -> true
+ | _ -> false
end
module String = struct
@@ -53,6 +75,11 @@ module String = struct
let lowercase_ascii s = map Char.lowercase_ascii s
let uppercase_ascii s = map Char.uppercase_ascii s
+ let capitalize_ascii s =
+ let b = Bytes.of_string s in
+ Bytes.unsafe_set b 0 (Char.uppercase_ascii (Bytes.unsafe_get b 0));
+ Bytes.to_string b
+
let is_prefix str prefix =
let n = length prefix in
length str >= n && sub str 0 n = prefix
@@ -92,6 +119,17 @@ module String = struct
s' ^ s2 ^ replace s'' s1 s2
)
+ let replace_char s c1 c2 =
+ let b2 = Bytes.of_string s in
+ let r = ref false in
+ for i = 0 to Bytes.length b2 - 1 do
+ if Bytes.unsafe_get b2 i = c1 then (
+ Bytes.unsafe_set b2 i c2;
+ r := true
+ )
+ done;
+ if not !r then s else Bytes.to_string b2
+
let rec nsplit sep str =
let len = length str in
let seplen = length sep in
@@ -152,10 +190,49 @@ module String = struct
make 1 c
) [1;2;3;4;5;6;7;8]
)
+
+ let triml ?(test = Char.isspace) str =
+ let i = ref 0 in
+ let n = ref (String.length str) in
+ while !n > 0 && test str.[!i]; do
+ decr n;
+ incr i
+ done;
+ if !i = 0 then str
+ else String.sub str !i !n
+
+ let trimr ?(test = Char.isspace) str =
+ let n = ref (String.length str) in
+ while !n > 0 && test str.[!n-1]; do
+ decr n
+ done;
+ if !n = String.length str then str
+ else String.sub str 0 !n
+
+ let trim ?(test = Char.isspace) str =
+ trimr ~test (triml ~test str)
+
+ let count_chars c str =
+ let count = ref 0 in
+ for i = 0 to String.length str - 1 do
+ if c = String.unsafe_get str i then incr count
+ done;
+ !count
+
+ let explode str =
+ let r = ref [] in
+ for i = 0 to String.length str - 1 do
+ let c = String.unsafe_get str i in
+ r := c :: !r;
+ done;
+ List.rev !r
+
+ let map_chars f str =
+ List.map f (explode str)
+
+ let spaces n = String.make n ' '
end
-exception Executable_not_found of string (* executable *)
-
let (//) = Filename.concat
let ( +^ ) = Int64.add
@@ -191,16 +268,6 @@ let le32_of_int i =
Bytes.unsafe_set b 3 (Char.unsafe_chr (Int64.to_int c3));
Bytes.to_string b
-let isdigit = function
- | '0'..'9' -> true
- | _ -> false
-
-let isxdigit = function
- | '0'..'9' -> true
- | 'a'..'f' -> true
- | 'A'..'F' -> true
- | _ -> false
-
type wrap_break_t = WrapEOS | WrapSpace | WrapNL
let rec wrap ?(chan = stdout) ?(indent = 0) str =
@@ -237,6 +304,8 @@ and _wrap_find_next_break i len str =
and output_spaces chan n = for i = 0 to n-1 do output_char chan ' ' done
+let (|>) x f = f x
+
(* Drop elements from a list while a predicate is true. *)
let rec dropwhile f = function
| [] -> []
@@ -255,6 +324,13 @@ let rec filter_map f = function
| Some y -> y :: filter_map f xs
| None -> filter_map f xs
+let rec find_map f = function
+ | [] -> raise Not_found
+ | x :: xs ->
+ match f x with
+ | Some y -> y
+ | None -> find_map f xs
+
let iteri f xs =
let rec loop i = function
| [] -> ()
@@ -326,6 +402,8 @@ let pop_front xsp =
let append xsp xs = xsp := !xsp @ xs
let prepend xs xsp = xsp := xs @ !xsp
+let unique = let i = ref 0 in fun () -> incr i; !i
+
let may f = function
| None -> ()
| Some x -> f x
@@ -339,6 +417,8 @@ let protect ~f ~finally =
finally ();
match r with Either ret -> ret | Or exn -> raise exn
+exception Executable_not_found of string (* executable *)
+
let which executable =
let paths =
try String.nsplit ":" (Sys.getenv "PATH")
@@ -390,6 +470,8 @@ let ansi_magenta ?(chan = stdout) () =
let ansi_restore ?(chan = stdout) () =
if colours () || istty chan then output_string chan "\x1b[0m"
+(*</stdlib>*)
+
(* Timestamped progress messages, used for ordinary messages when not
* --quiet.
*)
@@ -497,6 +579,8 @@ let print_version_and_exit () =
let generated_by =
sprintf (f_"generated by %s %s") prog Guestfs_config.package_version_full
+(*<stdlib>*)
+
let read_whole_file path =
let buf = Buffer.create 16384 in
let chan = open_in path in
@@ -513,6 +597,8 @@ let read_whole_file path =
close_in chan;
Buffer.contents buf
+(*</stdlib>*)
+
(* Parse a size field, eg. "10G". *)
let parse_size =
let const_re = Str.regexp "^\\([.0-9]+\\)\\([bKMG]\\)$" in
@@ -627,6 +713,8 @@ let create_standard_options argspec ?anon_fun ?(key_opts = false) usage_msg =
else []) in
Getopt.create argspec ?anon_fun usage_msg
+(*<stdlib>*)
+
(* Compare two version strings intelligently. *)
let rex_numbers = Str.regexp "^\\([0-9]+\\)\\(.*\\)$"
let rex_letters = Str.regexp_case_fold "^\\([a-z]+\\)\\(.*\\)$"
@@ -684,6 +772,8 @@ let stringify_args args =
| [] -> ""
| app :: xs -> app ^ quote_args xs
+(*</stdlib>*)
+
(* Run an external command, slurp up the output as a list of lines. *)
let external_command ?(echo_cmd = true) cmd =
if echo_cmd then
@@ -748,6 +838,8 @@ let uuidgen () =
if len < 10 then assert false; (* sanity check on uuidgen *)
uuid
+(*<stdlib>*)
+
(* Unlink a temporary file on exit. *)
let unlink_on_exit =
let files = ref [] in
@@ -769,6 +861,8 @@ let unlink_on_exit =
registered_handlers := true
)
+(*</stdlib>*)
+
(* Remove a temporary directory on exit. *)
let rmdir_on_exit =
let dirs = ref [] in
@@ -905,6 +999,8 @@ let detect_file_type filename =
close_in chan;
ret
+(*<stdlib>*)
+
let is_block_device file =
try (Unix.stat file).Unix.st_kind = Unix.S_BLK
with Unix.Unix_error _ -> false
@@ -913,6 +1009,8 @@ let is_char_device file =
try (Unix.stat file).Unix.st_kind = Unix.S_CHR
with Unix.Unix_error _ -> false
+(*</stdlib>*)
+
let is_partition dev =
try
if not (is_block_device dev) then false
@@ -926,6 +1024,8 @@ let is_partition dev =
)
with Unix.Unix_error _ -> false
+(*<stdlib>*)
+
(* Annoyingly Sys.is_directory throws an exception on failure
* (RHBZ#1022431).
*)
@@ -995,6 +1095,8 @@ let is_regular_file path = (* NB: follows symlinks. *)
try (Unix.stat path).Unix.st_kind = Unix.S_REG
with Unix.Unix_error _ -> false
+(*</stdlib>*)
+
let inspect_mount_root g ?mount_opts_fn root =
let mps = g#inspect_get_mountpoints root in
let cmp (a,_) (b,_) =
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index ad43345..7b142d4 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -16,6 +16,12 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
+(* The parts between <stdlib>..</stdlib> are copied into the
+ * generator/common_utils.ml file. These parts must ONLY use
+ * functions from the OCaml stdlib.
+ *)
+(*<stdlib>*)
+
module Char : sig
type t = char
val chr : int -> char
@@ -26,6 +32,13 @@ module Char : sig
val lowercase_ascii : char -> char
val uppercase_ascii : char -> char
+
+ val isspace : char -> bool
+ (** Return true if char is a whitespace character. *)
+ val isdigit : char -> bool
+ (** Return true if the character is a digit [[0-9]]. *)
+ val isxdigit : char -> bool
+ (** Return true if the character is a hex digit [[0-9a-fA-F]]. *)
end
(** Override the Char module from stdlib. *)
@@ -53,6 +66,7 @@ module String : sig
val lowercase_ascii : string -> string
val uppercase_ascii : string -> string
+ val capitalize_ascii : string -> string
val is_prefix : string -> string -> bool
(** [is_prefix str prefix] returns true if [prefix] is a prefix of [str]. *)
@@ -64,6 +78,8 @@ module String : sig
val replace : string -> string -> string -> string
(** [replace str s1 s2] replaces all instances of [s1] appearing in
[str] with [s2]. *)
+ val replace_char : string -> char -> char -> string
+ (** Replace character in string. *)
val nsplit : string -> string -> string list
(** [nsplit sep str] splits [str] into multiple strings at each
separator [sep]. *)
@@ -77,13 +93,23 @@ module String : sig
characters (i.e. [\] at the end of lines) into account. *)
val random8 : unit -> string
(** Return a string of 8 random printable characters. *)
+ val triml : ?test:(char -> bool) -> string -> string
+ (** Trim left. *)
+ val trimr : ?test:(char -> bool) -> string -> string
+ (** Trim right. *)
+ val trim : ?test:(char -> bool) -> string -> string
+ (** Trim left and right. *)
+ val count_chars : char -> string -> int
+ (** Count number of times the character occurs in string. *)
+ val explode : string -> char list
+ (** Explode a string into a list of characters. *)
+ val map_chars : (char -> 'a) -> string -> 'a list
+ (** Explode string, then map function over the characters. *)
+ val spaces : int -> string
+ (** [spaces n] creates a string of n spaces. *)
end
(** Override the String module from stdlib. *)
-(** Exception thrown by [which] when the specified executable is not found
- in [$PATH]. *)
-exception Executable_not_found of string (* executable *)
-
val ( // ) : string -> string -> string
(** Concatenate directory and filename. *)
@@ -105,17 +131,16 @@ val int_of_le32 : string -> int64
val le32_of_int : int64 -> string
(** Pack a 32 bit integer a 4 byte string stored little endian. *)
-val isdigit : char -> bool
-(** Return true if the character is a digit [[0-9]]. *)
-val isxdigit : char -> bool
-(** Return true if the character is a hex digit [[0-9a-fA-F]]. *)
-
val wrap : ?chan:out_channel -> ?indent:int -> string -> unit
(** Wrap text. *)
val output_spaces : out_channel -> int -> unit
(** Write [n] spaces to [out_channel]. *)
+val (|>) : 'a -> ('a -> 'b) -> 'b
+(** Added in OCaml 4.01, we can remove our definition when we
+ can assume this minimum version of OCaml. *)
+
val dropwhile : ('a -> bool) -> 'a list -> 'a list
(** [dropwhile f xs] drops leading elements from [xs] until
[f] returns false. *)
@@ -128,6 +153,10 @@ val takewhile : ('a -> bool) -> 'a list -> 'a list
val filter_map : ('a -> 'b option) -> 'a list -> 'b list
(** [filter_map f xs] applies [f] to each element of [xs]. If
[f x] returns [Some y] then [y] is added to the returned list. *)
+val find_map : ('a -> 'b option) -> 'a list -> 'b
+(** [find_map f xs] applies [f] to each element of [xs] until
+ [f x] returns [Some y]. It returns [y]. If we exhaust the
+ list then this raises [Not_found]. *)
val iteri : (int -> 'a -> 'b) -> 'a list -> unit
(** [iteri f xs] calls [f i x] for each element, with [i] counting from [0]. *)
val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
@@ -191,6 +220,9 @@ val prepend : 'a list -> 'a list ref -> unit
[prepend] is like {!push_front} above, except it prepends a list
to the list reference. *)
+val unique : unit -> int
+(** Returns a unique number each time called. *)
+
val may : ('a -> unit) -> 'a option -> unit
(** [may f (Some x)] runs [f x]. [may f None] does nothing. *)
@@ -209,6 +241,8 @@ val protect : f:(unit -> 'a) -> finally:(unit -> unit) -> 'a
case, but requires a lot more work by the caller. Perhaps we
will change this in future.) *)
+(*</stdlib>*)
+
val prog : string
(** The program name (derived from {!Sys.executable_name}). *)
@@ -253,9 +287,13 @@ val run_main_and_handle_errors : (unit -> unit) -> unit
val generated_by : string
(** The string ["generated by <prog> <version>"]. *)
+(*<stdlib>*)
+
val read_whole_file : string -> string
(** Read in the whole file as a string. *)
+(*</stdlib>*)
+
val parse_size : string -> int64
(** Parse a size field, eg. [10G] *)
@@ -275,6 +313,8 @@ val create_standard_options : Getopt.speclist -> ?anon_fun:Getopt.anon_fun -> ?k
Returns a new [Getopt.t] handle. *)
+(*<stdlib>*)
+
val compare_version : string -> string -> int
(** Compare two version strings. *)
@@ -285,6 +325,8 @@ val stringify_args : string list -> string
(** Create a "pretty-print" representation of a program invocation
(i.e. executable and its arguments). *)
+(*</stdlib>*)
+
val external_command : ?echo_cmd:bool -> string -> string list
(** Run an external command, slurp up the output as a list of lines.
@@ -306,9 +348,13 @@ val shell_command : ?echo_cmd:bool -> string -> int
val uuidgen : unit -> string
(** Run uuidgen to return a random UUID. *)
+(*<stdlib>*)
+
val unlink_on_exit : string -> unit
(** Unlink a temporary file on exit. *)
+(*</stdlib>*)
+
val rmdir_on_exit : string -> unit
(** Remove a temporary directory on exit (using [rm -rf]). *)
@@ -344,15 +390,21 @@ val debug_augeas_errors : Guestfs.guestfs -> unit
val detect_file_type : string -> [`GZip | `Tar | `XZ | `Zip | `Unknown]
(** Detect type of a file (for a very limited range of file types). *)
+(*<stdlib>*)
+
val is_block_device : string -> bool
val is_char_device : string -> bool
val is_directory : string -> bool
(** These don't throw exceptions, unlike the [Sys] functions. *)
+(*</stdlib>*)
+
val is_partition : string -> bool
(** Return true if the host device [dev] is a partition. If it's
anything else, or missing, returns false. *)
+(*<stdlib>*)
+
val absolute_path : string -> string
(** Convert any path to an absolute path. *)
@@ -381,6 +433,8 @@ val read_first_line_from_file : string -> string
val is_regular_file : string -> bool
(** Checks whether the file is a regular file. *)
+(*</stdlib>*)
+
val inspect_mount_root : Guestfs.guestfs -> ?mount_opts_fn:(string -> string) -> string -> unit
(** Mounts all the mount points of the specified root, just like
[guestfish -i] does.
@@ -395,6 +449,10 @@ val inspect_mount_root_ro : Guestfs.guestfs -> string -> unit
val is_btrfs_subvolume : Guestfs.guestfs -> string -> bool
(** Checks if a filesystem is a btrfs subvolume. *)
+exception Executable_not_found of string (* executable *)
+(** Exception thrown by [which] when the specified executable is not found
+ in [$PATH]. *)
+
val which : string -> string
(** Return the full path of the specified executable from [$PATH].
diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml
index f8337a0..558caac 100644
--- a/v2v/convert_windows.ml
+++ b/v2v/convert_windows.ml
@@ -113,7 +113,8 @@ let convert ~keep_serial_console (g : G.guestfs) inspect source rcaps =
*)
let is_gpo_guid name =
let len = String.length name in
- len > 3 && name.[0] = '{' && isxdigit name.[1] && name.[len-1] = '}'
+ len > 3 && name.[0] = '{' &&
+ Char.isxdigit name.[1] && name.[len-1] = '}'
in
List.exists is_gpo_guid children
with
--
2.10.2
More information about the Libguestfs
mailing list