Commit a2d68385 authored by Gerd Stolpmann's avatar Gerd Stolpmann

Adapting to the upcoming OCamlnet-4.1.

Compiling with -safe-string if supported by the compiler.
parent 8c435973
......@@ -4,8 +4,8 @@
# How to invoke compilers and tools:
OCAMLC = $(OCAMLFIND) ocamlc -g $(OCAMLC_OPTIONS) -package "$(PACKAGES)"
OCAMLOPT = $(OCAMLFIND) ocamlopt $(OCAMLOPT_OPTIONS) -package "$(PACKAGES)"
OCAMLC = $(OCAMLFIND) ocamlc -g $(STRING_OPTS) $(OCAMLC_OPTIONS) -package "$(PACKAGES)"
OCAMLOPT = $(OCAMLFIND) ocamlopt $(STRING_OPTS) $(OCAMLOPT_OPTIONS) -package "$(PACKAGES)"
OCAMLDEP = ocamldep $(OCAMLDEP_OPTIONS)
OCAMLFIND = ocamlfind
OCAMLYACC = ocamlyacc
......
......@@ -320,6 +320,19 @@ fi
rm -f tmp.*
######################################################################
# immutable strings
printf "%s" "Checking for -safe-string... "
string_opts=""
if ocamlc -safe-string; then
echo "yes"
string_opts="-safe-string"
else
echo "no"
fi
######################################################################
# Check cygwin
......@@ -470,6 +483,7 @@ CAMLP4_LOC = $camlp4_loc
CAMLP4_STYLE = $camlp4_style
CAMLP4_OPTS = $camlp4_opts
NETUNIDATA = $netunidata
STRING_OPTS = $string_opts
_EOF_
######################################################################
......
......@@ -25,8 +25,8 @@ module Str_hashtbl = Hashtbl.Make(HashedString);;
let character ?swarner enc warner k =
assert (k>=0);
if (k >= 0xd800 & k < 0xe000) or (k >= 0xfffe & k <= 0xffff) or k > 0x10ffff
or (k < 8) or (k = 11) or (k = 12) or (k >= 14 & k <= 31)
if (k >= 0xd800 && k < 0xe000) || (k >= 0xfffe && k <= 0xffff) || k > 0x10ffff
|| (k < 8) || (k = 11) || (k = 12) || (k >= 14 && k <= 31)
then
raise (WF_error("Code point " ^ string_of_int k ^
" outside the accepted range of code points"));
......@@ -54,7 +54,7 @@ let check_name ?swarner warner name =
let tokens_of_content_string lfactory s =
(* tokenizes general entities and character entities *)
let lexobj = lfactory # open_string_inplace s in
let lexobj = lfactory # open_string s in
let scan = lexobj # scan_content_string in
let rec next_token () =
match scan() with
......@@ -91,7 +91,7 @@ let rec expand_attvalue_with_rec_check (lexobj : lexer_obj) l dtd entities norm_
let l' =
try
expand_attvalue_with_rec_check
(lexobj # factory # open_string_inplace rtext)
(lexobj # factory # open_string rtext)
(String.length rtext)
dtd (n :: entities) false
with
......@@ -135,7 +135,7 @@ let expand_attvalue (lexobj : lexer_obj) dtd s norm_crlf =
*)
(* print_string ("expand_attvalue \"" ^ s ^ "\" = "); *)
try
lexobj # open_string_inplace s;
lexobj # open_string s;
let l =
expand_attvalue_with_rec_check
lexobj (String.length s) dtd [] norm_crlf in
......@@ -185,7 +185,7 @@ let count_lines lc s =
let tokens_of_xml_pi (lfactory : lexer_factory) s =
let lexobj = lfactory # open_string_inplace (s ^ " ") in
let lexobj = lfactory # open_string (s ^ " ") in
let scan = lexobj # scan_xml_pi in
let rec collect () =
let t = scan() in
......@@ -297,7 +297,7 @@ let check_attribute_value_lexically (lfactory:lexer_factory) x t v =
* - t = A_enum _: v must match <nmtoken>
* - t = A_cdata: not checked
*)
let lexobj = lfactory # open_string_inplace v in
let lexobj = lfactory # open_string v in
let scan = lexobj#scan_name_string in
let rec get_name_list() =
match scan() with
......@@ -341,7 +341,7 @@ let split_attribute_value (lfactory:lexer_factory) v =
* the names/nmtokens in 'v' is suppressed and not returned.
*)
(* print_string ("split_attribute_value \"" ^ v ^ "\" = "); *)
let lexobj = lfactory # open_string_inplace v in
let lexobj = lfactory # open_string v in
let scan = lexobj # scan_name_string in
let rec get_name_list() =
match scan() with
......@@ -366,22 +366,22 @@ let rev_concat l =
List.iter
(fun s -> k := !k + String.length s)
l;
let r = String.create !k in
let r = Bytes.create !k in
List.iter
(fun s ->
let n = String.length s in
k := !k - n;
String.(*unsafe_*)blit s 0 r !k n;
Bytes.(*unsafe_*)blit_string s 0 r !k n;
)
l;
assert(!k = 0);
r
Bytes.to_string r
;;
let normalize_line_separators (lfactory:lexer_factory) s =
(* Note: Returns [s] if [s] does not contain LFs *)
let lexobj = lfactory # open_string_inplace s in
let lexobj = lfactory # open_string s in
let scan = lexobj # scan_for_crlf in
let rec get_string l =
match scan() with
......@@ -714,14 +714,14 @@ let write_markup_string ~(from_enc:rep_encoding) ~to_enc os s =
let s' =
if to_enc = (from_enc :> encoding)
then s
else recode_string
~in_enc:(from_enc :> encoding)
~out_enc:to_enc
~subst:(fun n ->
failwith
("Pxp_aux.write_markup_string: Cannot represent " ^
"code point " ^ string_of_int n))
s
else convert
~in_enc:(from_enc :> encoding)
~out_enc:to_enc
~subst:(fun n ->
failwith
("Pxp_aux.write_markup_string: Cannot represent " ^
"code point " ^ string_of_int n))
s
in
write os s' 0 (String.length s')
;;
......@@ -740,7 +740,7 @@ let write_data_string ~(from_enc:rep_encoding) ~to_enc os content =
if to_enc = (from_enc :> encoding)
then s
else
recode_string
convert
~in_enc:(from_enc :> encoding)
~out_enc:to_enc
~subst:(fun n -> assert false)
......@@ -759,7 +759,7 @@ let write_data_string ~(from_enc:rep_encoding) ~to_enc os content =
if to_enc = (from_enc :> encoding) then
write os content j l
else begin
let s' = recode_string
let s' = convert
~in_enc:(from_enc :> encoding)
~out_enc:to_enc
~subst:(fun n ->
......
......@@ -80,7 +80,7 @@ type 't array_stack =
let stack_create null =
(* null: a dummy element *)
{ stack_array = Array.create 100 null;
{ stack_array = Array.make 100 null;
stack_top = -1;
stack_null = null;
}
......@@ -91,7 +91,7 @@ let stack_push x st =
let top = st.stack_top + 1 in
if top >= Array.length st.stack_array then
st.stack_array <- Array.append
st.stack_array (Array.create 100 st.stack_null);
st.stack_array (Array.make 100 st.stack_null);
st.stack_array.(top) <- x;
st.stack_top <- top
;;
......@@ -505,7 +505,7 @@ class virtual core_parser
if config.encoding = `Enc_utf8 then
s (* No recoding necessary *)
else
Netconversion.recode_string
Netconversion.convert
~in_enc:(config.encoding :> encoding) ~out_enc:`Enc_utf8 s
in
......
......@@ -299,9 +299,11 @@ module A = struct
let write os str pos len =
match os with
`Out_buffer b -> Buffer.add_substring b str pos len
| `Out_channel ch -> output ch str pos len
| `Out_channel ch -> output ch (Bytes.unsafe_of_string str) pos len
(* FIXME: use output_substring instead *)
| `Out_function f -> f str pos len
| `Out_netchannel ch -> ch # really_output str pos len
| `Out_netchannel ch -> ch # really_output (Bytes.unsafe_of_string str) pos len
(* FIXME: use really_output_string instead *)
;;
......
......@@ -1312,7 +1312,7 @@ class virtual ['ext] container_features an_ext =
)
method nth_node p =
if p < 0 or p >= size then raise Not_found;
if p < 0 || p >= size then raise Not_found;
match nodes with
LA_not_available ->
if rev_nodes = [] then
......@@ -2239,7 +2239,7 @@ class [ 'ext ] element_impl an_ext (* : ['ext] element_node *) =
if m > 0 then begin
(* round 1 *)
let att_found = Array.create m false in
let att_found = Array.make m false in
(* whether the declared attribute has been found *)
(* First iterate over new_attlist, then over new_attvalues: *)
(* new_attlist: *)
......
......@@ -662,7 +662,7 @@ class dtd ?swarner the_warner init_encoding =
method validate =
if validated or allow_arbitrary then
if validated || allow_arbitrary then
()
else begin
(* Validity constraint: Notations in NDATA entity declarations must
......@@ -786,7 +786,7 @@ and dtd_element the_dtd the_name =
method add_attribute aname t d extdecl =
let swarner = dtd#swarner
and warner = dtd#warner in
if aname <> "xml:lang" & aname <> "xml:space" then
if aname <> "xml:lang" && aname <> "xml:space" then
check_name ?swarner warner aname;
if List.mem_assoc aname attributes then
warn swarner warner (`W_multiple_attribute_declarations(name,aname))
......@@ -878,9 +878,9 @@ and dtd_element the_dtd the_name =
( match vr with
None ->
let n = List.length attributes in
let init_att_vals = Array.create n ("", Implied_value) in
let init_att_vals = Array.make n ("", Implied_value) in
let att_lookup = Str_hashtbl.create n in
let att_info = Array.create n (A_cdata, false) in
let att_info = Array.make n (A_cdata, false) in
let att_required = ref [] in
let k = ref 0 in
List.iter
......@@ -1099,7 +1099,7 @@ and dtd_element the_dtd the_name =
(* Validity Constraint: ID Attribute Default *)
if List.exists
(fun (n,((t,d),_)) ->
t = A_id & (d <> D_required & d <> D_implied))
t = A_id && (d <> D_required && d <> D_implied))
attributes
then
raise(Validation_error("ID attribute must be #IMPLIED or #REQUIRED; element `" ^ name ^ "'"));
......
......@@ -1174,7 +1174,7 @@ class internal_entity the_dtd the_name the_swarner the_warner the_literal_value
let en = v.dtd # par_entity n in
let (x, extref) = en # replacement_text in
contains_external_references <-
contains_external_references or extref;
contains_external_references || extref;
x ^ scan_and_expand()
| Eof ->
""
......
......@@ -188,7 +188,7 @@ object
method encoding : Pxp_core_types.I.rep_encoding
method open_source : Pxp_reader.lexer_source -> lexer_obj
method open_string : string -> lexer_obj
method open_string_inplace : string -> lexer_obj
method open_bytes_inplace : Bytes.t -> lexer_obj
end
and lexer_obj =
......@@ -197,7 +197,7 @@ object
method encoding : Pxp_core_types.I.rep_encoding
method open_source : Pxp_reader.lexer_source -> unit
method open_string : string -> unit
method open_string_inplace : string -> unit
method open_bytes_inplace : Bytes.t -> unit
method scan_document : unit -> (token * lexers)
method scan_content : unit -> (token * lexers)
......
......@@ -155,7 +155,7 @@ object
method open_string : string -> lexer_obj
(** Open a string as source *)
method open_string_inplace : string -> lexer_obj
method open_bytes_inplace : Bytes.t -> lexer_obj
(** Open a string as source.
* The string is physically used as lexical buffer (no copy is made)
*)
......@@ -178,7 +178,7 @@ object
method open_string : string -> unit
(** Drop the current source, and open the string as next source *)
method open_string_inplace : string -> unit
method open_bytes_inplace : Bytes.t -> unit
(** Drop the current source, and open the string as next source.
* The string is physically used as lexical buffer (no copy is made)
*)
......
......@@ -17,7 +17,7 @@ object
failwith msg
method open_string _ =
failwith msg
method open_string_inplace _ =
method open_bytes_inplace _ =
failwith msg
end
......@@ -56,7 +56,7 @@ let get_lexer_set (enc : rep_encoding) = (* DEPRECATED *)
let src = { lsrc_lexbuf =
lazy buf;
lsrc_unicode_lexbuf =
lazy(Netulex.ULB.from_string enc' buf.Lexing.lex_buffer)
lazy(Netulex.ULB.from_string enc' (Bytes.unsafe_to_string buf.Lexing.lex_buffer))
} in
let obj = factory # open_source src in
old_obj := Some obj;
......
......@@ -14,7 +14,7 @@ val from_channel : in_channel -> lexbuf
val from_string : string -> lexbuf
val from_function : (string -> int -> int) -> lexbuf
val from_function : (Bytes.t -> int -> int) -> lexbuf
val lexeme : lexbuf -> string
......@@ -29,17 +29,11 @@ val lexeme_char : lexbuf -> int -> char
val lexeme_len : lexbuf -> int
(* = String.length(lexeme lexbuf) *)
val from_string_inplace : string -> Lexing.lexbuf
val from_bytes_inplace : Bytes.t -> Lexing.lexbuf
(* Similar to Lexing.from_string, but does not copy the passed string
* intially
*)
val from_another_string_inplace : Lexing.lexbuf -> string -> unit
(* lexbuf: a buffer from a previous Lexing.from_string
* (or from_string_inplace).
* Modifies lexbuf such that the lexer starts again with the passed string
*)
val sub_lexeme : Lexing.lexbuf -> int -> int -> string
(* Same as String.sub (Lexing.lexeme lexbuf) k l, but avoids one string
* allocation
......
......@@ -30,39 +30,15 @@ let lexeme_end = Lexing.lexeme_end
let lexeme_len lexbuf =
lexbuf.lex_curr_pos - lexbuf.lex_start_pos
let from_string_inplace s =
let from_bytes_inplace s =
(* avoids copying s *)
let lb = from_string "" in
{ lb with
lex_buffer = s;
lex_buffer_len = String.length s
lex_buffer_len = Bytes.length s
}
;;
let from_another_string_inplace lexbuf s =
(* uses lexbuf again for another string (avoids memory allocation) *)
lexbuf.lex_buffer <- s;
lexbuf.lex_buffer_len <- String.length s;
lexbuf.lex_abs_pos <- 0;
lexbuf.lex_start_pos <- 0;
lexbuf.lex_curr_pos <- 0;
lexbuf.lex_last_pos <- 0;
lexbuf.lex_last_action <- 0;
lexbuf.lex_eof_reached <- true;
IFDEF LEXBUF_307
let zero_pos = {
pos_fname = "";
pos_lnum = 1;
pos_bol = 0;
pos_cnum = 0;
} in
lexbuf.lex_mem <- [| |];
lexbuf.lex_start_p <- zero_pos;
lexbuf.lex_curr_p <- zero_pos
ENDIF
;;
let sub_lexeme lexbuf k l =
(* = String.sub (Lexing.lexeme lexbuf) k l *)
(* In recent versions of O'Caml (3.06+X), there are already definitions
......@@ -72,9 +48,9 @@ let sub_lexeme lexbuf k l =
let lexeme_len = lexbuf.lex_curr_pos - lexbuf.lex_start_pos in
if (k < 0 || k > lexeme_len || l < 0 || k+l > lexeme_len) then
invalid_arg "sub_lexeme";
let s = String.create l in
String.unsafe_blit
let s = Bytes.create l in
Bytes.unsafe_blit
lexbuf.lex_buffer (lexbuf.lex_start_pos + k) s 0 l;
s
Bytes.unsafe_to_string s
;;
......@@ -10,7 +10,7 @@
let rec index_rec s i =
let s_i = String.unsafe_get s i in
if s_i = '\010' or s_i = '\013'
if s_i = '\010' || s_i = '\013'
then i
else index_rec s (i+1)
;;
......@@ -18,7 +18,7 @@ let rec index_rec s i =
let rec index_lim_rec s lim i =
if i >= lim then -1 else
let s_i = String.unsafe_get s i in
if s_i = '\010' or s_i = '\013'
if s_i = '\010' || s_i = '\013'
then i
else index_lim_rec s lim (i+1)
;;
......@@ -28,23 +28,8 @@ let crlf_index_from s i =
assert (i>=0 && i <= lim);
if lim = 0 || i = lim then
-1
else if lim <= 9 then begin
else
index_lim_rec s lim i
end
else begin
let c = String.unsafe_get s (lim-1) in
String.unsafe_set s (lim-1) '\010';
let k = index_rec s i in
String.unsafe_set s (lim-1) c;
if k = lim-1 then begin
if c = '\010' then
k
else
-1
end
else
k
end
;;
exception Found;;
......
......@@ -104,7 +104,7 @@ type jobber =
let recode_string ~in_enc ~out_enc =
Netconversion.recode_string
Netconversion.convert
~in_enc
~out_enc
~subst:(fun k ->
......@@ -133,7 +133,7 @@ let subtree_to_cmd_sequence_nohead
* and may be restarted by executing f() (resulting again in Done or Task).
*)
let m = 100 in
let current_array = Array.create m End_node in (* Collects up to [m] cmds *)
let current_array = Array.make m End_node in (* Collects up to [m] cmds *)
let current_pos = ref 0 in (* next free index *)
let write_nobreak cmd =
(* Call [write] but ignore interruptions *)
......@@ -345,7 +345,9 @@ let subtree_to_cmd_sequence ?(omit_positions=false) ?enc f n =
None -> (n#encoding :> encoding), id
| Some e -> e, (recode_string
~in_enc:(n#encoding :> encoding)
~out_enc:e)
~out_enc:e
?range_pos:None
?range_len:None)
in
let encname = Netconversion.string_of_encoding enc in
let sa = n#dtd#standalone_declaration in
......@@ -396,8 +398,8 @@ let subtree_from_cmd_sequence_nohead ~rev_tbl ~recode f0 dtd spec =
| Some (pos_e,pos_l,pos_p) -> Some (recode pos_e,pos_l,pos_p)
in
let default = get_data_exemplar spec in
let eltypes = ref (Array.create 100 ("",default)) in
let atts = ref (Array.create 100 "") in
let eltypes = ref (Array.make 100 ("",default)) in
let atts = ref (Array.make 100 "") in
let mng = new namespace_manager in
let mng_found = ref false in
let enable_mng, dest_mng =
......@@ -459,7 +461,7 @@ let subtree_from_cmd_sequence_nohead ~rev_tbl ~recode f0 dtd spec =
let eltype = recode eltype in
if nr > Array.length !eltypes then begin
eltypes :=
Array.append !eltypes (Array.create 100 ("",default));
Array.append !eltypes (Array.make 100 ("",default));
end;
let eltype' =
if !mng_found then
......@@ -475,7 +477,7 @@ let subtree_from_cmd_sequence_nohead ~rev_tbl ~recode f0 dtd spec =
let name = recode name in
if nr > Array.length !atts then begin
atts :=
Array.append !atts (Array.create 100 "");
Array.append !atts (Array.make 100 "");
end;
let name' =
if !mng_found then
......@@ -598,6 +600,8 @@ let subtree_from_cmd_sequence f dtd spec =
recode_string
~in_enc:enc
~out_enc:(dtd # encoding :> encoding)
?range_pos:None
?range_len:None
in
let rev_tbl = Hashtbl.create 20 in
......@@ -701,6 +705,8 @@ let document_from_cmd_sequence f config spec =
recode_string
~in_enc:enc
~out_enc:(config.encoding :> encoding)
?range_pos:None
?range_len:None
in
let cmd1 = f() in
let xml_version =
......
......@@ -51,14 +51,14 @@ let ensure_space_minimum p f g =
* that the string buffer has the minimum free space [p]. This is achieved
* by using an auxiliary buffer.
*)
let buf = String.create p in
let buf = Bytes.create p in
let bufpos = ref 0 in
let buflen = ref 0 in
f (fun s n ->
assert(n>0);
if !buflen > 0 then (
let m = min n !buflen in
String.blit buf !bufpos s 0 m;
Bytes.blit buf !bufpos s 0 m;
bufpos := !bufpos + m;
buflen := !buflen - m;
m
......@@ -67,7 +67,7 @@ let ensure_space_minimum p f g =
if n < p then (
let l = g buf p in
let m = min l n in
String.blit buf 0 s 0 m;
Bytes.blit buf 0 s 0 m;
bufpos := m;
buflen := l-m;
m
......@@ -140,8 +140,8 @@ class virtual resolve_general real_class
(* Called if a character not representable has been found.
* k is the character code.
*)
if k < 0xd800 or (k >= 0xe000 & k <= 0xfffd) or
(k >= 0x10000 & k <= 0x10ffff) then begin
if k < 0xd800 || (k >= 0xe000 && k <= 0xfffd) ||
(k >= 0x10000 && k <= 0x10ffff) then begin
warn swarner warner (`W_code_point_cannot_be_represented k);
end
else
......@@ -158,23 +158,23 @@ class virtual resolve_general real_class
*
* Returns the number of bytes to eat up in the buffer
*)
if String.sub s 0 2 = "\254\255" then (
if Bytes.sub s 0 2 = Bytes.of_string "\254\255" then (
encoding <- `Enc_utf16_be;
2
)
else if String.sub s 0 4 = "\000\060\000\063" then (
else if Bytes.sub s 0 4 = Bytes.of_string "\000\060\000\063" then (
encoding <- `Enc_utf16_be;
0
)
else if String.sub s 0 2 = "\255\254" then (
else if Bytes.sub s 0 2 = Bytes.of_string "\255\254" then (
encoding <- `Enc_utf16_le;
2
)
else if String.sub s 0 4 = "\060\000\063\000" then (
else if Bytes.sub s 0 4 = Bytes.of_string "\060\000\063\000" then (
encoding <- `Enc_utf16_le;
0
)
else if String.sub s 0 3 = "\239\187\191" then (
else if Bytes.sub s 0 3 = Bytes.of_string "\239\187\191" then (
(* That's the unusual case of a byte order mark in UTF-8 encoding.
This is not mentioned in the XML standard, but Unicode allows it.
*)
......@@ -187,7 +187,7 @@ class virtual resolve_general real_class
)
method private virtual next_string : string -> int -> int -> int
method private virtual next_string : Bytes.t -> int -> int -> int
method private virtual init_in : resolver_id -> unit
method virtual close_in : unit
(* must reset is_open! *)
......@@ -201,7 +201,7 @@ class virtual resolve_general real_class
let direct_reader = ref false in (* whether to bypass the buffer *)
let buf_max = 4096 in
let buf = ref (String.make buf_max ' ') in
let buf = ref (Bytes.make buf_max ' ') in
let buf_beg = ref 0 in
let buf_end = ref 0 in
let buf_eof = ref false in
......@@ -237,7 +237,7 @@ class virtual resolve_general real_class
* at least one character.
*)
let m = !buf_end - !buf_beg in
String.blit !buf !buf_beg !buf 0 m;
Bytes.blit !buf !buf_beg !buf 0 m;
buf_beg := 0;
buf_end := m;
refill();
......@@ -255,9 +255,9 @@ class virtual resolve_general real_class
)
else (
let (n_in, n_out, encoding') =
Netconversion.recode
Netconversion.recode_tstring
~in_enc:encoding
~in_buf:!buf
~in_buf:(`Bytes !buf)
~in_pos:!buf_beg
~in_len:m
~out_enc:(internal_encoding : rep_encoding :> encoding)
......@@ -319,7 +319,7 @@ class virtual resolve_general real_class
if !buf_beg < !buf_end then (
(* There are still bytes in [buf], return them first *)
let m = min n (!buf_end - !buf_beg) in
String.blit !buf !buf_beg s 0 m;
Bytes.blit !buf !buf_beg s 0 m;
buf_beg := !buf_beg + m;
m
)
......@@ -327,7 +327,7 @@ class virtual resolve_general real_class
(* Either we are already at EOF, or we can switch to
* [direct_reader].
*)
buf := ""; (* Free buf, it will never be used again *)
buf := Bytes.of_string ""; (* Free buf, it will never be used again *)
if !buf_eof then
0
else (
......@@ -372,7 +372,7 @@ class virtual resolve_general real_class
buf_eof := (n=0)
done;
if Netbuffer.length buf >= 4 then (
let n_skip = self # autodetect (Netbuffer.contents buf) in
let n_skip = self # autodetect (Netbuffer.to_bytes buf) in
Netbuffer.delete buf 0 n_skip
)
);
......@@ -403,8 +403,8 @@ class virtual resolve_general real_class
*)
if Netbuffer.length buf > 0 then (
let c = (Netbuffer.contents buf).[0] in
s.[p] <- c;
let c = Netbuffer.get buf 0 in
Bytes.set s p c;
Netbuffer.delete buf 0 1;
1
)
......@@ -811,7 +811,7 @@ class resolve_as_file
if base_url_defaults_to_cwd then begin
let cwd = Sys.getcwd() in
let cwd_utf8 =
Netconversion.recode_string
Netconversion.convert
~in_enc: system_encoding
~out_enc: `Enc_utf8
cwd in
......@@ -894,7 +894,7 @@ class resolve_as_file
(* Note: it is only assumed that the path is UTF-8 *)
let path =
Netconversion.recode_string
Netconversion.convert
~in_enc: `Enc_utf8
~out_enc: system_encoding
path_utf8 in
......@@ -925,7 +925,7 @@ class resolve_as_file
let make_file_url ?(system_encoding = `Enc_utf8) ?(enc = `Enc_utf8) filename =
let utf8_filename =
Netconversion.recode_string
Netconversion.convert
~in_enc: enc
~out_enc: `Enc_utf8
filename
......@@ -934,7 +934,7 @@ let make_file_url ?(system_encoding = `Enc_utf8) ?(enc = `Enc_utf8) filename =
let getcwd() =
let cwd = Sys.getcwd() in
let cwd_utf8 =
Netconversion.recode_string
Netconversion.convert
~in_enc: system_encoding
~out_enc: `Enc_utf8
cwd in
......
......@@ -180,17 +180,17 @@ object (self)
| _ ->
let accu = ref (String.length current_string) in
List.iter (fun s -> accu := !accu + String.length s) current_data;
let str = String.create !accu in
let str = Bytes.create !accu in
let pos = ref (!accu) in
List.iter
(fun s ->
let l = String.length s in
pos := !pos - l;
String.blit s 0 str !pos l
Bytes.blit_string s 0 str !pos l
)
current_data;
String.blit current_string 0 str 0 (String.length current_string);
add_node (create_data_node spec dtd str);