Blame SOURCES/0005-ocaml-Use-caml_alloc_initialized_string-instead-of-m.patch

da373f
From 3b4082b239ec0976b366293067e42f91d56cfcd5 Mon Sep 17 00:00:00 2001
da373f
From: "Richard W.M. Jones" <rjones@redhat.com>
da373f
Date: Thu, 6 Feb 2020 10:15:29 +0000
da373f
Subject: [PATCH] ocaml: Use caml_alloc_initialized_string instead of memcpy.
da373f
da373f
Since about 2017 OCaml has had a function for creating an initialized
da373f
string.  This uses the function instead of caml_alloc_string + memcpy
da373f
(which doesn't work for OCaml 4.10) and defines a replacement if the
da373f
function is missing.
da373f
da373f
Note this requires configure.ac in libguestfs.git and virt-v2v.git to
da373f
define HAVE_CAML_ALLOC_INITIALIZED_STRING.
da373f
da373f
(cherry picked from commit 398dc56a6cb5d6d01506338fa94ef580e668d5e9)
da373f
---
da373f
 common/mlpcre/pcre-c.c   | 16 ++++++++++++++--
da373f
 common/mlvisit/visit-c.c | 16 ++++++++++++++--
da373f
 common/mlxml/xml-c.c     | 16 ++++++++++++++--
da373f
 3 files changed, 42 insertions(+), 6 deletions(-)
da373f
da373f
diff --git a/common/mlpcre/pcre-c.c b/common/mlpcre/pcre-c.c
da373f
index 07f99b8d6..7dbba5857 100644
da373f
--- a/common/mlpcre/pcre-c.c
da373f
+++ b/common/mlpcre/pcre-c.c
da373f
@@ -39,6 +39,19 @@
da373f
 
da373f
 #pragma GCC diagnostic ignored "-Wmissing-prototypes"
da373f
 
da373f
+/* Replacement if caml_alloc_initialized_string is missing, added
da373f
+ * to OCaml runtime in 2017.
da373f
+ */
da373f
+#ifndef HAVE_CAML_ALLOC_INITIALIZED_STRING
da373f
+static inline value
da373f
+caml_alloc_initialized_string (mlsize_t len, const char *p)
da373f
+{
da373f
+  value sv = caml_alloc_string (len);
da373f
+  memcpy ((char *) String_val (sv), p, len);
da373f
+  return sv;
da373f
+}
da373f
+#endif
da373f
+
da373f
 /* Data on the most recent match is stored in this thread-local
da373f
  * variable.  It is freed either by the next call to PCRE.matches or
da373f
  * by (clean) thread exit.
da373f
@@ -257,8 +270,7 @@ guestfs_int_pcre_sub (value nv)
da373f
   if (len < 0)
da373f
     raise_pcre_error ("pcre_get_substring", len);
da373f
 
da373f
-  strv = caml_alloc_string (len);
da373f
-  memcpy (String_val (strv), str, len);
da373f
+  strv = caml_alloc_initialized_string (len, str);
da373f
   CAMLreturn (strv);
da373f
 }
da373f
 
da373f
diff --git a/common/mlvisit/visit-c.c b/common/mlvisit/visit-c.c
da373f
index 201f6d762..d5585ca94 100644
da373f
--- a/common/mlvisit/visit-c.c
da373f
+++ b/common/mlvisit/visit-c.c
da373f
@@ -35,6 +35,19 @@
da373f
 
da373f
 #pragma GCC diagnostic ignored "-Wmissing-prototypes"
da373f
 
da373f
+/* Replacement if caml_alloc_initialized_string is missing, added
da373f
+ * to OCaml runtime in 2017.
da373f
+ */
da373f
+#ifndef HAVE_CAML_ALLOC_INITIALIZED_STRING
da373f
+static inline value
da373f
+caml_alloc_initialized_string (mlsize_t len, const char *p)
da373f
+{
da373f
+  value sv = caml_alloc_string (len);
da373f
+  memcpy ((char *) String_val (sv), p, len);
da373f
+  return sv;
da373f
+}
da373f
+#endif
da373f
+
da373f
 struct visitor_function_wrapper_args {
da373f
   /* In both case we are pointing to local roots, hence why these are
da373f
    * value* not value.
da373f
@@ -198,8 +211,7 @@ copy_xattr (const struct guestfs_xattr *xattr)
da373f
   rv = caml_alloc (2, 0);
da373f
   v = caml_copy_string (xattr->attrname);
da373f
   Store_field (rv, 0, v);
da373f
-  v = caml_alloc_string (xattr->attrval_len);
da373f
-  memcpy (String_val (v), xattr->attrval, xattr->attrval_len);
da373f
+  v = caml_alloc_initialized_string (xattr->attrval_len, xattr->attrval);
da373f
   Store_field (rv, 1, v);
da373f
   CAMLreturn (rv);
da373f
 }
da373f
diff --git a/common/mlxml/xml-c.c b/common/mlxml/xml-c.c
da373f
index d3db7e227..a0fa0fc3d 100644
da373f
--- a/common/mlxml/xml-c.c
da373f
+++ b/common/mlxml/xml-c.c
da373f
@@ -40,6 +40,19 @@
da373f
 
da373f
 #pragma GCC diagnostic ignored "-Wmissing-prototypes"
da373f
 
da373f
+/* Replacement if caml_alloc_initialized_string is missing, added
da373f
+ * to OCaml runtime in 2017.
da373f
+ */
da373f
+#ifndef HAVE_CAML_ALLOC_INITIALIZED_STRING
da373f
+static inline value
da373f
+caml_alloc_initialized_string (mlsize_t len, const char *p)
da373f
+{
da373f
+  value sv = caml_alloc_string (len);
da373f
+  memcpy ((char *) String_val (sv), p, len);
da373f
+  return sv;
da373f
+}
da373f
+#endif
da373f
+
da373f
 /* xmlDocPtr type */
da373f
 #define docptr_val(v) (*((xmlDocPtr *)Data_custom_val(v)))
da373f
 
da373f
@@ -183,8 +196,7 @@ mllib_xml_to_string (value docv, value formatv)
da373f
   doc = docptr_val (docv);
da373f
   xmlDocDumpFormatMemory (doc, &mem, &size, Bool_val (formatv));
da373f
 
da373f
-  strv = caml_alloc_string (size);
da373f
-  memcpy (String_val (strv), mem, size);
da373f
+  strv = caml_alloc_initialized_string (size, mem);
da373f
   free (mem);
da373f
 
da373f
   CAMLreturn (strv);
da373f
-- 
da373f
2.18.4
da373f