Added -safe-string compilation flag

Author: mmottl

_tags

@@ -65,5 +65,5 @@
 true: -traverse
 <{lib,examples}/**>: traverse
 
-<**/*.ml{,i}>: warn(Aer-44), strict_sequence, annot
+<**/*.ml{,i}>: warn(Aer-44), strict_sequence, safe_string, annot
 "lib/postgresql.cmxs": use_libpostgresql_stubs

lib/postgresql.ml

@@ -24,6 +24,7 @@
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 
+open Postgresql_compat
 open Printf
 
 type oid = int
@@ -447,10 +448,10 @@ module Stub = struct
   (* Functions Associated with the COPY Command *)
 
   external getline :
-    connection -> string -> int -> int -> int = "PQgetline_stub"
+    connection -> Bytes.t -> int -> int -> int = "PQgetline_stub"
 
   external getline_async :
-    connection -> string -> int -> int -> int = "PQgetlineAsync_stub" "noalloc"
+    connection -> Bytes.t -> int -> int -> int = "PQgetlineAsync_stub" "noalloc"
 
   external putline : connection -> string -> int = "PQputline_stub"
 
@@ -485,7 +486,7 @@ module Stub = struct
   external lo_unlink : connection -> oid -> oid = "lo_unlink_stub"
 
   external lo_read :
-    connection -> large_object -> string -> int -> int -> int = "lo_read_stub"
+    connection -> large_object -> Bytes.t -> int -> int -> int = "lo_read_stub"
 
   external lo_read_ba :
     connection -> large_object ->
@@ -856,7 +857,7 @@ object (self)
   (* Low level *)
 
   method getline ?(pos = 0) ?len buf =
-    let buf_len = String.length buf in
+    let buf_len = Bytes.length buf in
     let len = match len with Some len -> len | None -> buf_len - pos in
     if len < 0 || pos < 0 || pos + len > buf_len then
       invalid_arg "Postgresql.connection#getline";
@@ -868,7 +869,7 @@ object (self)
       | _ -> assert false)
 
   method getline_async ?(pos = 0) ?len buf =
-    let buf_len = String.length buf in
+    let buf_len = Bytes.length buf in
     let len = match len with Some len -> len | None -> buf_len - pos in
     if len < 0 || pos < 0 || pos + len > buf_len then
       invalid_arg "Postgresql.connection#getline_async";
@@ -877,7 +878,7 @@ object (self)
       | -1 -> if Stub.endcopy conn <> 0 then signal_error conn else EndOfData
       | 0 -> NoData
       | n when n > 0 ->
-         if buf.[pos + n - 1] = '\n' then DataRead n else PartDataRead n
+         if Bytes.get buf (pos + n - 1) = '\n' then DataRead n else PartDataRead n
       | _ -> assert false)
 
   method putline buf =
@@ -900,17 +901,17 @@ object (self)
   method copy_out f =
     let buf = Buffer.create 1024 in
     let len = 512 in
-    let s = String.create len in
+    let bts = Bytes.create len in
     wrap_conn (fun conn ->
       let rec loop () =
-        let r = Stub.getline conn s 0 len in
+        let r = Stub.getline conn bts 0 len in
         if r = 1 then begin  (* Buffer full *)
-          Buffer.add_substring buf s 0 len;
+          buffer_add_subbytes buf bts 0 len;
           loop ()
         end
         else if r = 0 then  (* Line read *)
-          let zero = String.index s '\000' in
-          Buffer.add_substring buf s 0 zero;
+          let zero = Bytes.index bts '\000' in
+          buffer_add_subbytes buf bts 0 zero;
           match Buffer.contents buf with
           | "\\." -> ()
           | line -> Buffer.clear buf; f line; loop ()
@@ -1000,9 +1001,9 @@ object (self)
       if w < len then signal_error conn)
 
   method lo_read lo ?(pos = 0) ?len buf =
-    let buf_len = String.length buf in
+    let buf_len = Bytes.length buf in
     let len = match len with Some len -> len | None -> buf_len - pos in
-    if len < 0 || pos < 0 || pos + len > String.length buf then
+    if len < 0 || pos < 0 || pos + len > buf_len then
       invalid_arg "Postgresql.connection#lo_read";
     wrap_conn (fun conn ->
       let read = Stub.lo_read conn lo buf pos len in

lib/postgresql.mli

@@ -24,6 +24,8 @@
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 
+open Postgresql_compat
+
 (** Client-interface to the PostgreSQL database. *)
 
 (** Please learn about more details in the database documentation! *)
@@ -669,30 +671,30 @@ object
 
   (** Low level *)
 
-  method getline : ?pos : int -> ?len : int -> string -> getline_result
+  method getline : ?pos : int -> ?len : int -> Bytes.t -> getline_result
   (** [getline ?pos ?len buf] reads a newline-terminated line of at most
       [len] characters into [buf] starting at position [pos].
 
       @return getline_result
 
       @param pos default = 0
-      @param len default = String.length buf - pos
+      @param len default = Bytes.length buf - pos
 
       @raise Invalid_argument if the buffer parameters are invalid.
       @raise Error if there is a connection error.
   *)
 
   method getline_async :
-    ?pos : int -> ?len : int -> string -> getline_async_result
+    ?pos : int -> ?len : int -> Bytes.t -> getline_async_result
   (** [getline_async ?pos ?len buf] reads a newline-terminated line of
       at most [len] characters into [buf] starting at position [pos]
-      (asynchronously). No need to call [endcopy] after receiving
+      (asynchronously).  No need to call [endcopy] after receiving
       [EndOfData].
 
       @return getline_async_result
 
       @param pos default = 0
-      @param len default = String.length buf - pos
+      @param len default = Bytes.length buf - pos
 
       @raise Invalid_argument if the buffer parameters are invalid.
       @raise Error if there is a connection error.
@@ -865,12 +867,12 @@ object
     large_object -> unit
   (** As [lo_write], but performs a zero-copy write from the given Bigarray. *)
 
-  method lo_read : large_object -> ?pos : int -> ?len : int -> string -> int
+  method lo_read : large_object -> ?pos : int -> ?len : int -> Bytes.t -> int
   (** [lo_read lo ?pos ?len buf] reads [len] bytes from large object [lo]
       to buffer [buf] starting at position [pos].
 
       @param pos default = 0
-      @param len default = String.length buf - pos
+      @param len default = Bytes.length buf - pos
 
       @raise Invalid_argument if the buffer parameters are invalid.
       @raise Error if [len] bytes could not be read.

lib/postgresql_compat.ml

@@ -0,0 +1,3 @@
+module Bytes = Bytes
+
+let buffer_add_subbytes = Buffer.add_subbytes

lib/postgresql_compat312.ml

@@ -0,0 +1,3 @@
+module Bytes = String
+
+let buffer_add_subbytes = Buffer.add_substring

lib/postgresql_compat402.ml

@@ -0,0 +1,3 @@
+module Bytes = Bytes
+
+let buffer_add_subbytes = Buffer.add_subbytes

setup.ml

@@ -7075,4 +7075,24 @@ let setup () = BaseSetup.setup setup_t;;
 
 # 7077 "setup.ml"
 (* OASIS_STOP *)
+
+let () =
+  let ocaml_major, ocaml_minor =
+    Scanf.sscanf Sys.ocaml_version "%i.%i" (fun v1 v2 -> v1, v2) in
+  let cp_file src dst =
+    let ic = open_in src in
+    let oc = open_out dst in
+    try while true do output_string oc (input_line ic ^ "\n") done
+    with End_of_file ->
+      close_out oc;
+      close_in ic
+  in
+  let src =
+    if ocaml_major > 4 || (ocaml_major = 4 && ocaml_minor >= 2) then
+      "lib/postgresql_compat402.ml"
+    else
+      "lib/postgresql_compat312.ml"
+  in
+  cp_file src "lib/postgresql_compat.ml"
+
 let () = setup ();;