Safe-string compatibility

configure

@@ -69,7 +69,7 @@ done
 echo "\
 VERSION = $VERSION
 
-OCAMLBUILD = $OCAMLBUILD -cflags -w,Ae,-warn-error,A -lflags -w,Ae,-warn-error,A -no-links -classic-display
+OCAMLBUILD = $OCAMLBUILD -use-ocamlfind -no-links -classic-display
 
 BINDIR = $BINDIR
 MAN1DIR = $MANDIR/man1

src/Makefile

@@ -18,7 +18,7 @@ TARGS = $(BIN)/ocamlpp
 all: $(TARGS)
 
 $(BIN)/%: $(SRCS) config.ml
-	$(OCAMLBUILD) -cflag -g -lflag -g $*.native
+	$(OCAMLBUILD) $*.native
 	cp _build/$*.native $@
 
 config.ml: ../etc/config.ml

src/_tags

@@ -0,0 +1,2 @@
+true: debug, bin_annot, warn(Ae), warn_error(A)
+true: package(bytes)

src/cmoparser.ml

@@ -16,9 +16,9 @@ let cmo_magic_number = "Caml1999O007";;
 let parse file_name =
   let ic = open_in_bin file_name in
   try
-    let buffer = String.create (String.length cmo_magic_number) in
-    really_input ic buffer 0 (String.length cmo_magic_number);
-    if buffer = cmo_magic_number then begin
+    let read_magic =
+      Util.really_input_string ic (String.length cmo_magic_number) in
+    if read_magic = cmo_magic_number then begin
       let compunit_pos = input_binary_int ic in (* Go to descriptor *)
       seek_in ic compunit_pos;
       let compunit = (input_value ic : Cmo.compilation_unit) in

src/code.ml

@@ -91,14 +91,16 @@ let parse_segment ic offset length =
   let cpt = ref 0 in
   let nb_bc = length lsr 2 in
   let read =
-    let buf4 = String.create 4 in
+    let buf4 = Bytes.create 4 in
     fun () ->
       incr cpt;
       if !cpt > nb_bc then raise End_of_file;
       really_input ic buf4 0 4;
       let res =
-        (int_of_char buf4.[0]) lor (int_of_char buf4.[1] lsl 8) lor
-          (int_of_char buf4.[2] lsl 16) lor (int_of_char buf4.[3] lsl 24)
+            (int_of_char (Bytes.get buf4 0))
+        lor (int_of_char (Bytes.get buf4 1) lsl 8)
+        lor (int_of_char (Bytes.get buf4 2) lsl 16)
+        lor (int_of_char (Bytes.get buf4 3) lsl 24)
       in
       match Sys.word_size with
         | 32 -> res

src/data.ml

@@ -79,7 +79,7 @@ let string_of_elem e =
 let parse ic index =
   let (offset, _) =
     try Index.find_section index Index.Data
-    with Not_found -> failwith "code section not found"
+    with Not_found -> failwith "data section not found"
   in
   seek_in ic offset;
   let (tbl : Obj.t array) = input_value ic in

src/index.ml

@@ -14,21 +14,19 @@ exception Not_a_byte
 type section_name = Code | Dlpt | Dlls | Prim | Data | Symb | Crcs | Dbug
 
 type t = (section_name * int * int) list
-    
+
 let parse ic =
   let magic_str = "Caml1999X008" in
   let magic_size = String.length magic_str in
   let file_length = in_channel_length ic in
-  let buf_magic = String.create magic_size in
-  let buf4 = String.create 4 in
   let read_int offset =
     seek_in ic offset;
     input_binary_int ic
   in
   let read_name offset =
     seek_in ic offset;
-    really_input ic buf4 0 4;
-    match buf4 with
+    let name = Util.really_input_string ic 4 in
+    match name with
       | "CODE" -> Code
       | "DLPT" -> Dlpt
       | "DLLS" -> Dlls
@@ -37,11 +35,11 @@ let parse ic =
       | "SYMB" -> Symb
       | "CRCS" -> Crcs
       | "DBUG" -> Dbug
-      | _ -> failwith (Printf.sprintf "invalid section name: `%s'" buf4)
+      | _ -> failwith (Printf.sprintf "invalid section name: `%s'" name)
   in
   seek_in ic (file_length - magic_size);
-  really_input ic buf_magic 0 magic_size;
-  if buf_magic <> magic_str then raise Not_a_byte;
+  let read_magic = Util.really_input_string ic magic_size in
+  if read_magic <> magic_str then raise Not_a_byte;
   let size = read_int (file_length - magic_size - 4) in
   let rec f ind next_offset rem =
     if ind <> -1 then

src/util.ml

@@ -0,0 +1,6 @@
+let really_input_string ic len =
+  let s = Bytes.create len in
+  really_input ic s 0 len;
+  (* s is local and does not escape:
+    it will never be written again and we can transfer ownership *)
+  Bytes.unsafe_to_string s

src/util.mli

@@ -0,0 +1,4 @@
+val really_input_string : in_channel -> int -> string
+(** This utility is provided in recent OCaml version (4.02), but not
+    in older versions so we included it here (it is trivial to implement)
+    for backward compatibility. *)