Wed Mar 14 10:16:04 2018 UTC ()
Fix build with ocaml 4.06
(dholland)
diff -r1.63 -r1.64 pkgsrc/net/unison2.32/Makefile
diff -r1.2 -r1.3 pkgsrc/net/unison2.32/distinfo
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-bytearray.ml
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-bytearray.mli
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-bytearray__stubs.c
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-case.ml
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-fileutil.ml
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-fingerprint.ml
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-fspath.ml
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-lwt_lwt__unix.ml
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-lwt_lwt__unix.mli
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-osx.ml
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-path.ml
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-remote.ml
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-terminal.ml
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-test.ml
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-transfer.ml
diff -r0 -r1.1 pkgsrc/net/unison2.32/patches/patch-uicommon.ml
--- pkgsrc/net/unison2.32/Attic/Makefile 2018/03/12 11:17:24 1.63
+++ pkgsrc/net/unison2.32/Attic/Makefile 2018/03/14 10:16:03 1.64
| @@ -1,34 +1,37 @@ | | | @@ -1,34 +1,37 @@ |
1 | # $NetBSD: Makefile,v 1.63 2018/03/12 11:17:24 wiz Exp $ | | 1 | # $NetBSD: Makefile,v 1.64 2018/03/14 10:16:03 dholland Exp $ |
2 | | | 2 | |
3 | DISTNAME= unison-2.32.52 | | 3 | DISTNAME= unison-2.32.52 |
4 | PKGREVISION= 64 | | 4 | PKGREVISION= 64 |
5 | | | 5 | |
6 | CATEGORIES= net | | 6 | CATEGORIES= net |
7 | MASTER_SITES= http://www.seas.upenn.edu/~bcpierce/unison/download/releases/stable/ | | 7 | MASTER_SITES= http://www.seas.upenn.edu/~bcpierce/unison/download/releases/stable/ |
8 | | | 8 | |
9 | MAINTAINER= tonio@NetBSD.org | | 9 | MAINTAINER= tonio@NetBSD.org |
10 | HOMEPAGE= http://www.cis.upenn.edu/~bcpierce/unison/ | | 10 | HOMEPAGE= http://www.cis.upenn.edu/~bcpierce/unison/ |
11 | COMMENT= File-synchronization tool (old 2.32 branch) | | 11 | COMMENT= File-synchronization tool (old 2.32 branch) |
12 | LICENSE= gnu-gpl-v3 | | 12 | LICENSE= gnu-gpl-v3 |
13 | | | 13 | |
14 | BUILDLINK_API_DEPENDS.ocaml+= ocaml>=3.08.2 | | 14 | BUILDLINK_API_DEPENDS.ocaml+= ocaml>=3.08.2 |
15 | | | 15 | |
16 | # docs: unison-manual.pdf/html/ps/dvi | | 16 | # docs: unison-manual.pdf/html/ps/dvi |
17 | WRKSRC= ${WRKDIR}/${PKGNAME_NOREV} | | 17 | WRKSRC= ${WRKDIR}/${PKGNAME_NOREV} |
18 | USE_TOOLS+= gmake | | 18 | USE_TOOLS+= gmake |
19 | MAKE_FLAGS+= CFLAGS="" | | 19 | MAKE_FLAGS+= CFLAGS="" |
20 | MAKE_ENV+= HOME=${WRKDIR:Q} | | 20 | MAKE_ENV+= HOME=${WRKDIR:Q} |
21 | | | 21 | |
| | | 22 | # with -j, runs only about half the build and then stops |
| | | 23 | MAKE_JOBS_SAFE= no |
| | | 24 | |
22 | .include "options.mk" | | 25 | .include "options.mk" |
23 | .include "../../mk/bsd.prefs.mk" | | 26 | .include "../../mk/bsd.prefs.mk" |
24 | | | 27 | |
25 | .if (${MACHINE_ARCH} == "i386") || (${MACHINE_ARCH} == "powerpc") || (${MACHINE_ARCH} == "sparc") | | 28 | .if (${MACHINE_ARCH} == "i386") || (${MACHINE_ARCH} == "powerpc") || (${MACHINE_ARCH} == "sparc") |
26 | MAKE_FLAGS+= NATIVE=true | | 29 | MAKE_FLAGS+= NATIVE=true |
27 | .else | | 30 | .else |
28 | MAKE_FLAGS+= NATIVE=false | | 31 | MAKE_FLAGS+= NATIVE=false |
29 | .endif | | 32 | .endif |
30 | | | 33 | |
31 | .include "../../mk/pthread.buildlink3.mk" | | 34 | .include "../../mk/pthread.buildlink3.mk" |
32 | | | 35 | |
33 | .if defined(PTHREAD_TYPE) && (${PTHREAD_TYPE} != "none") | | 36 | .if defined(PTHREAD_TYPE) && (${PTHREAD_TYPE} != "none") |
34 | MAKE_FLAGS+= THREADS=true | | 37 | MAKE_FLAGS+= THREADS=true |
--- pkgsrc/net/unison2.32/Attic/distinfo 2015/11/04 00:35:42 1.2
+++ pkgsrc/net/unison2.32/Attic/distinfo 2018/03/14 10:16:03 1.3
| @@ -1,8 +1,24 @@ | | | @@ -1,8 +1,24 @@ |
1 | $NetBSD: distinfo,v 1.2 2015/11/04 00:35:42 agc Exp $ | | 1 | $NetBSD: distinfo,v 1.3 2018/03/14 10:16:03 dholland Exp $ |
2 | | | 2 | |
3 | SHA1 (unison-2.32.52.tar.gz) = 68ea5709de4fcc2f9aef7b01b24637503b61b5ac | | 3 | SHA1 (unison-2.32.52.tar.gz) = 68ea5709de4fcc2f9aef7b01b24637503b61b5ac |
4 | RMD160 (unison-2.32.52.tar.gz) = 8216a2e482d5a445dd7acdb62e1bb6377e90d1a1 | | 4 | RMD160 (unison-2.32.52.tar.gz) = 8216a2e482d5a445dd7acdb62e1bb6377e90d1a1 |
5 | SHA512 (unison-2.32.52.tar.gz) = a97ab23ca8b87575653f6fea4f7eba7fb5aacb8cfa0195ebfff70ecc38f88f26677b26d76c8ba68bd2dac24bdabfabc2f7334ab94bd4b4c0eeb94303438dbda1 | | 5 | SHA512 (unison-2.32.52.tar.gz) = a97ab23ca8b87575653f6fea4f7eba7fb5aacb8cfa0195ebfff70ecc38f88f26677b26d76c8ba68bd2dac24bdabfabc2f7334ab94bd4b4c0eeb94303438dbda1 |
6 | Size (unison-2.32.52.tar.gz) = 697866 bytes | | 6 | Size (unison-2.32.52.tar.gz) = 697866 bytes |
7 | SHA1 (patch-aa) = d59adf3446ea3f98f4ab72274b95b1140d3cf896 | | 7 | SHA1 (patch-aa) = d59adf3446ea3f98f4ab72274b95b1140d3cf896 |
8 | SHA1 (patch-ab) = 29a2bc3842be7bb1bde7372dfeca2a5c5b4acdef | | 8 | SHA1 (patch-ab) = 29a2bc3842be7bb1bde7372dfeca2a5c5b4acdef |
| | | 9 | SHA1 (patch-bytearray.ml) = efe1e039f9f64c204229b0d6d483a480ce13dce7 |
| | | 10 | SHA1 (patch-bytearray.mli) = a93299b6880159c66b2e3feed2db10b53a99489f |
| | | 11 | SHA1 (patch-bytearray__stubs.c) = 6ad17f3c6a581b749f1c6d52149377f908179290 |
| | | 12 | SHA1 (patch-case.ml) = 20721eb771af7a446961af5a2e1c9bcb958a87dc |
| | | 13 | SHA1 (patch-fileutil.ml) = cfa84095f6a3d249d483fcf6aaeb18083ee3593d |
| | | 14 | SHA1 (patch-fingerprint.ml) = 709e0ee1fa3ccdc22ac00421d0538e37f35c31b1 |
| | | 15 | SHA1 (patch-fspath.ml) = d4929f4bf127100ca400de1c0f3a560975cfdb96 |
| | | 16 | SHA1 (patch-lwt_lwt__unix.ml) = 61196ccbb2b4f689698f2cab3079ed40984f2773 |
| | | 17 | SHA1 (patch-lwt_lwt__unix.mli) = 0e9d553cced1ff8c86188e6a4b9acd5963c26e6f |
| | | 18 | SHA1 (patch-osx.ml) = d90bf2df6f15883c692b1dcfcbba461ca955c345 |
| | | 19 | SHA1 (patch-path.ml) = f48a08d01e2bfeff405d9a882cf6a4ab30bd48f4 |
| | | 20 | SHA1 (patch-remote.ml) = 5e275cbc374b2ff519f69e7656a205009f7160d5 |
| | | 21 | SHA1 (patch-terminal.ml) = 1e84fb39df5e4d5a1df39a1cc35879d73369ca3c |
| | | 22 | SHA1 (patch-test.ml) = 6a23b78ad5270bb7ad9c7dcf9b043b44a090f611 |
| | | 23 | SHA1 (patch-transfer.ml) = fd33382fa283e25a705659651105b74f290431f9 |
| | | 24 | SHA1 (patch-uicommon.ml) = 54602d200323fd1d0eb18741fb06572846d434a4 |
$NetBSD: patch-bytearray.ml,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- bytearray.ml~ 2009-05-29 14:00:18.000000000 +0000
+++ bytearray.ml
@@ -36,17 +36,20 @@ let unsafe_blit_to_string a i s j l =
*)
external unsafe_blit_from_string : string -> int -> t -> int -> int -> unit
- = "ml_blit_string_to_bigarray" "noalloc"
+ = "ml_blit_string_to_bigarray" [@@noalloc]
-external unsafe_blit_to_string : t -> int -> string -> int -> int -> unit
- = "ml_blit_bigarray_to_string" "noalloc"
+external unsafe_blit_from_bytes : bytes -> int -> t -> int -> int -> unit
+ = "ml_blit_bytes_to_bigarray" [@@noalloc]
+
+external unsafe_blit_to_bytes : t -> int -> bytes -> int -> int -> unit
+ = "ml_blit_bigarray_to_bytes" [@@noalloc]
let to_string a =
let l = length a in
if l > Sys.max_string_length then invalid_arg "Bytearray.to_string" else
- let s = String.create l in
- unsafe_blit_to_string a 0 s 0 l;
- s
+ let s = Bytes.create l in
+ unsafe_blit_to_bytes a 0 s 0 l;
+ Bytes.to_string s
let of_string s =
let l = String.length s in
@@ -60,9 +63,9 @@ let sub a ofs len =
then
invalid_arg "Bytearray.sub"
else begin
- let s = String.create len in
- unsafe_blit_to_string a ofs s 0 len;
- s
+ let s = Bytes.create len in
+ unsafe_blit_to_bytes a ofs s 0 len;
+ Bytes.to_string s
end
let rec prefix_rec a i a' i' l =
@@ -81,11 +84,17 @@ let blit_from_string s i a j l =
then invalid_arg "Bytearray.blit_from_string"
else unsafe_blit_from_string s i a j l
-let blit_to_string a i s j l =
+let blit_from_bytes s i a j l =
+ if l < 0 || i < 0 || i > Bytes.length s - l
+ || j < 0 || j > length a - l
+ then invalid_arg "Bytearray.blit_from_bytes"
+ else unsafe_blit_from_bytes s i a j l
+
+let blit_to_bytes a i s j l =
if l < 0 || i < 0 || i > length a - l
- || j < 0 || j > String.length s - l
- then invalid_arg "Bytearray.blit_to_string"
- else unsafe_blit_to_string a i s j l
+ || j < 0 || j > Bytes.length s - l
+ then invalid_arg "Bytearray.blit_to_bytes"
+ else unsafe_blit_to_bytes a i s j l
external marshal : 'a -> Marshal.extern_flags list -> t
= "ml_marshal_to_bigarray"
$NetBSD: patch-bytearray.mli,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- bytearray.mli~ 2009-05-29 14:00:18.000000000 +0000
+++ bytearray.mli
@@ -16,7 +16,9 @@ val sub : t -> int -> int -> string
val blit_from_string : string -> int -> t -> int -> int -> unit
-val blit_to_string : t -> int -> string -> int -> int -> unit
+val blit_from_bytes : bytes -> int -> t -> int -> int -> unit
+
+val blit_to_bytes : t -> int -> bytes -> int -> int -> unit
val prefix : t -> t -> int -> bool
$NetBSD: patch-bytearray__stubs.c,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- bytearray_stubs.c~ 2009-05-29 14:00:18.000000000 +0000
+++ bytearray_stubs.c
@@ -35,11 +35,20 @@ CAMLprim value ml_blit_string_to_bigarra
return Val_unit;
}
-CAMLprim value ml_blit_bigarray_to_string
+CAMLprim value ml_blit_bytes_to_bigarray
+(value s, value i, value a, value j, value l)
+{
+ char *src = Bytes_val(s) + Int_val(i);
+ char *dest = Array_data(Bigarray_val(a), j);
+ memcpy(dest, src, Long_val(l));
+ return Val_unit;
+}
+
+CAMLprim value ml_blit_bigarray_to_bytes
(value a, value i, value s, value j, value l)
{
char *src = Array_data(Bigarray_val(a), i);
- char *dest = String_val(s) + Long_val(j);
+ char *dest = Bytes_val(s) + Long_val(j);
memcpy(dest, src, Long_val(l));
return Val_unit;
}
$NetBSD: patch-case.ml,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- case.ml~ 2009-05-29 12:54:25.000000000 +0000
+++ case.ml
@@ -56,19 +56,19 @@ let needNormalization s =
let removeTrailingDots s =
let len = String.length s in
- let s' = String.create len in
+ let s' = Bytes.create len in
let pos = ref (len - 1) in
let pos' = ref (len - 1) in
while !pos >= 0 do
while !pos >= 0 && s.[!pos] = '.' do decr pos done;
while !pos >= 0 && s.[!pos] <> '/' do
- s'.[!pos'] <- s.[!pos]; decr pos; decr pos'
+ Bytes.set s' !pos' s.[!pos]; decr pos; decr pos'
done;
while !pos >= 0 && s.[!pos] = '/' do
- s'.[!pos'] <- s.[!pos]; decr pos; decr pos'
+ Bytes.set s' !pos' s.[!pos]; decr pos; decr pos'
done
done;
- String.sub s' (!pos' + 1) (len - !pos' - 1)
+ Bytes.to_string (Bytes.sub s' (!pos' + 1) (len - !pos' - 1))
(* Dots are ignored at the end of filenames under Windows. *)
let normalize s =
$NetBSD: patch-fileutil.ml,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- fileutil.ml~ 2009-05-02 02:31:27.000000000 +0000
+++ fileutil.ml
@@ -21,14 +21,14 @@ let backslashes2forwardslashes s0 =
try
ignore(String.index s0 '\\'); (* avoid alloc if possible *)
let n = String.length s0 in
- let s = String.create n in
+ let s = Bytes.create n in
for i = 0 to n-1 do
let c = String.get s0 i in
if c = '\\'
- then String.set s i '/'
- else String.set s i c
+ then Bytes.set s i '/'
+ else Bytes.set s i c
done;
- s
+ Bytes.to_string s
with Not_found -> s0
let rec removeTrailingSlashes s =
$NetBSD: patch-fingerprint.ml,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- fingerprint.ml~ 2009-05-02 02:31:27.000000000 +0000
+++ fingerprint.ml
@@ -66,13 +66,13 @@ let hexaCode theChar =
let toString md5 =
let length = String.length md5 in
- let string = String.create (length * 2) in
+ let string = Bytes.create (length * 2) in
for i=0 to (length - 1) do
let c1, c2 = hexaCode (md5.[i]) in
- string.[2*i] <- c1;
- string.[2*i + 1] <- c2;
+ Bytes.set string (2*i) c1;
+ Bytes.set string (2*i + 1) c2;
done;
- string
+ Bytes.to_string string
let string = Digest.string
$NetBSD: patch-fspath.ml,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- fspath.ml~ 2009-05-02 02:31:27.000000000 +0000
+++ fspath.ml
@@ -50,7 +50,7 @@ let winRootFix d =
(* least distinguishing suffixes of two fspaths, for displaying in the user *)
(* interface. *)
let differentSuffix (Fspath f1) (Fspath f2) =
- if isRootDir f1 or isRootDir f2 then (f1,f2)
+ if isRootDir f1 || isRootDir f2 then (f1,f2)
else begin
(* We use the invariant that neither f1 nor f2 ends in slash *)
let len1 = String.length f1 in
@@ -180,11 +180,11 @@ let concat fspath path =
let p = Path.toString path in
let l = String.length fspath in
let l' = String.length p in
- let s = String.create (l + l' + 1) in
+ let s = Bytes.create (l + l' + 1) in
String.blit fspath 0 s 0 l;
- s.[l] <- '/';
+ Bytes.set s l '/';
String.blit p 0 s (l + 1) l';
- Fspath s
+ Fspath (Bytes.to_string s)
end
(* Filename.dirname is screwed up in Windows so we use this function. It *)
$NetBSD: patch-lwt_lwt__unix.ml,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- lwt/lwt_unix.ml~ 2009-06-09 15:46:38.000000000 +0000
+++ lwt/lwt_unix.ml
@@ -169,7 +169,8 @@ let rec run thread =
(fun () ->
try ignore (Unix.getpeername fd) with
Unix.Unix_error (Unix.ENOTCONN, _, _) ->
- ignore (Unix.read fd " " 0 1))
+ let junk = Bytes.create 1 in
+ ignore (Unix.read fd junk 0 1))
| `Wait res ->
wrap_syscall inputs fd res (fun () -> ())
with Not_found ->
@@ -291,8 +292,8 @@ let wait () = waitpid [] (-1)
let system cmd =
match Unix.fork () with
0 -> begin try
- Unix.execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |];
- assert false
+ Unix.execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]
+ (*; assert false*)
with _ ->
exit 127
end
@@ -335,24 +336,24 @@ let rec unsafe_really_input ic s ofs len
end
let really_input ic s ofs len =
- if ofs < 0 || len < 0 || ofs > String.length s - len
+ if ofs < 0 || len < 0 || ofs > Bytes.length s - len
then Lwt.fail (Invalid_argument "really_input")
else unsafe_really_input ic s ofs len
let input_line ic =
- let buf = ref (String.create 128) in
+ let buf = ref (Bytes.create 128) in
let pos = ref 0 in
let rec loop () =
- if !pos = String.length !buf then begin
- let newbuf = String.create (2 * !pos) in
- String.blit !buf 0 newbuf 0 !pos;
+ if !pos = Bytes.length !buf then begin
+ let newbuf = Bytes.create (2 * !pos) in
+ Bytes.blit !buf 0 newbuf 0 !pos;
buf := newbuf
end;
Lwt.bind (input_char ic) (fun c ->
if c = '\n' then
Lwt.return ()
else begin
- !buf.[!pos] <- c;
+ Bytes.set !buf !pos c;
incr pos;
loop ()
end)
@@ -366,9 +367,9 @@ let input_line ic =
| _ ->
Lwt.fail e))
(fun () ->
- let res = String.create !pos in
- String.blit !buf 0 res 0 !pos;
- Lwt.return res)
+ let res = Bytes.create !pos in
+ Bytes.blit !buf 0 res 0 !pos;
+ Lwt.return (Bytes.to_string res))
(****)
@@ -391,8 +392,8 @@ let open_proc cmd proc input output tocl
Unix.close output
end;
List.iter Unix.close toclose;
- Unix.execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |];
- exit 127
+ Unix.execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]
+ (*exit 127*)
| id -> Hashtbl.add popen_processes proc id
let open_process_in cmd =
@@ -434,8 +435,8 @@ let open_proc_full cmd env proc output i
Unix.dup2 output Unix.stdout; Unix.close output;
Unix.dup2 error Unix.stderr; Unix.close error;
List.iter Unix.close toclose;
- Unix.execve "/bin/sh" [| "/bin/sh"; "-c"; cmd |] env;
- exit 127
+ Unix.execve "/bin/sh" [| "/bin/sh"; "-c"; cmd |] env
+ (*exit 127*)
| id -> Hashtbl.add popen_processes proc id
let open_process_full cmd env =
$NetBSD: patch-lwt_lwt__unix.mli,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- lwt/lwt_unix.mli~ 2009-05-02 02:31:27.000000000 +0000
+++ lwt/lwt_unix.mli
@@ -30,8 +30,8 @@ val run : 'a Lwt.t -> 'a
this library, you must first turn them into non-blocking mode
using [Unix.set_nonblock]. *)
-val read : Unix.file_descr -> string -> int -> int -> int Lwt.t
-val write : Unix.file_descr -> string -> int -> int -> int Lwt.t
+val read : Unix.file_descr -> bytes -> int -> int -> int Lwt.t
+val write : Unix.file_descr -> bytes -> int -> int -> int Lwt.t
val pipe : unit -> (Unix.file_descr * Unix.file_descr) Lwt.t
val socket :
Unix.socket_domain -> Unix.socket_type -> int -> Unix.file_descr Lwt.t
@@ -51,8 +51,8 @@ type lwt_out_channel
val input_char : lwt_in_channel -> char Lwt.t
val input_line : lwt_in_channel -> string Lwt.t
-val input : lwt_in_channel -> string -> int -> int -> int Lwt.t
-val really_input : lwt_in_channel -> string -> int -> int -> unit Lwt.t
+val input : lwt_in_channel -> bytes -> int -> int -> int Lwt.t
+val really_input : lwt_in_channel -> bytes -> int -> int -> unit Lwt.t
val open_process_in: string -> lwt_in_channel Lwt.t
val open_process_out: string -> lwt_out_channel Lwt.t
$NetBSD: patch-osx.ml,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- osx.ml~ 2009-06-18 08:36:04.000000000 +0000
+++ osx.ml
@@ -56,12 +56,12 @@ let appleDoubleFile fspath path =
let len = String.length f in
try
let i = 1 + String.rindex f '/' in
- let res = String.create (len + 2) in
+ let res = Bytes.create (len + 2) in
String.blit f 0 res 0 i;
- res.[i] <- '.';
- res.[i + 1] <- '_';
+ Bytes.set res i '.';
+ Bytes.set res (i + 1) '_';
String.blit f i res (i + 2) (len - i);
- res
+ Bytes.to_string res
with Not_found ->
assert false
@@ -70,7 +70,7 @@ let doubleVersion = "\000\002\000\000"
let doubleFiller = String.make 16 '\000'
let ressource_fork_empty_tag = "This resource fork intentionally left blank "
let finfoLength = 32L
-let emptyFinderInfo () = String.make 32 '\000'
+let emptyFinderInfo () = Bytes.make 32 '\000'
let empty_ressource_fork =
"\000\000\001\000" ^
"\000\000\001\000" ^
@@ -118,26 +118,26 @@ let getID buf ofs =
| _ -> `UNKNOWN
let setInt4 v =
- let s = String.create 4 in
+ let s = Bytes.create 4 in
let set i =
- s.[i] <-
- Char.chr (Int64.to_int (Int64.logand 255L
- (Int64.shift_right v (24 - 8 * i)))) in
+ Bytes.set s i
+ (Char.chr (Int64.to_int (Int64.logand 255L
+ (Int64.shift_right v (24 - 8 * i))))) in
set 0; set 1; set 2; set 3;
- s
+ Bytes.to_string s
let fail path msg =
raise (Util.Transient
(Format.sprintf "Malformed AppleDouble file '%s' (%s)" path msg))
let readDouble path inch len =
- let buf = String.create len in
+ let buf = Bytes.create len in
begin try
really_input inch buf 0 len
with End_of_file ->
fail path "truncated"
end;
- buf
+ Bytes.to_string buf
let readDoubleFromOffset path inch offset len =
LargeFile.seek_in inch offset;
@@ -226,7 +226,13 @@ let extractInfo typ info =
let xflags = String.sub info 24 2 in
let typeCreator = String.sub info 0 8 in
(* Ignore hasBeenInited flag *)
+
+(*
flags.[0] <- Char.chr (Char.code flags.[0] land 0xfe);
+*)
+ let fix i c = if i = 0 then Char.chr (Char.code c land 0xfe) else c in
+ let flags = String.mapi fix flags in
+
(* If the extended flags should be ignored, clear them *)
let xflags =
if Char.code xflags.[0] land 0x80 <> 0 then "\000\000" else xflags
@@ -265,9 +271,9 @@ let getFileInfos fspath path typ =
protect (fun () ->
LargeFile.seek_in inch (Int64.add offset 16L);
let len = String.length ressource_fork_empty_tag in
- let buf = String.create len in
+ let buf = Bytes.create len in
really_input inch buf 0 len;
- buf = ressource_fork_empty_tag)
+ Bytes.to_string buf = ressource_fork_empty_tag)
(fun () -> close_in_noerr inch)
then
(0L, 0L)
@@ -341,7 +347,7 @@ let setFileInfos fspath path finfo =
let (fullFinfo, _) =
getFileInfosInternal (Fspath.concatToString fspath path) false in
setFileInfosInternal (Fspath.concatToString fspath path)
- (insertInfo fullFinfo finfo)
+ (Bytes.to_string (insertInfo (Bytes.of_string fullFinfo) finfo))
with Unix.Unix_error ((Unix.EOPNOTSUPP | Unix.ENOSYS), _, _) ->
(* Not an HFS volume. Look for an AppleDouble file *)
let (fspath, path) = Fspath.findWorkingDir fspath path in
@@ -363,7 +369,7 @@ let setFileInfos fspath path finfo =
protect
(fun () ->
writeDoubleFromOffset doublePath outch ofs
- (insertInfo fullFinfo finfo);
+ (Bytes.to_string (insertInfo (Bytes.of_string fullFinfo) finfo));
close_out outch)
(fun () ->
close_out_noerr outch);
@@ -400,7 +406,7 @@ let setFileInfos fspath path finfo =
output_string outch "\000\000\000\002"; (* Ressource fork *)
output_string outch "\000\000\014\226"; (* offset *)
output_string outch "\000\000\001\030"; (* length *)
- output_string outch (insertInfo (emptyFinderInfo ()) finfo);
+ output_bytes outch (insertInfo (emptyFinderInfo ()) finfo);
output_string outch (empty_attribute_chunk ());
(* extended attributes *)
output_string outch empty_ressource_fork;
@@ -509,7 +515,7 @@ let openRessOut fspath path length =
output_string outch "\000\000\014\226"; (* offset *)
output_string outch (setInt4 (Uutil.Filesize.toInt64 length));
(* length *)
- output_string outch (emptyFinderInfo ());
+ output_bytes outch (emptyFinderInfo ());
output_string outch (empty_attribute_chunk ());
(* extended attributes *)
flush outch)
$NetBSD: patch-path.ml,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- path.ml~ 2009-05-02 02:31:27.000000000 +0000
+++ path.ml
@@ -30,11 +30,11 @@ let concat p p' =
if l = 0 then p' else
let l' = String.length p' in
if l' = 0 then p else
- let p'' = String.create (l + l' + 1) in
+ let p'' = Bytes.create (l + l' + 1) in
String.blit p 0 p'' 0 l;
- p''.[l] <- pathSeparatorChar;
+ Bytes.set p'' l pathSeparatorChar;
String.blit p' 0 p'' (l + 1) l';
- p''
+ Bytes.to_string p''
let empty = ""
@@ -182,11 +182,11 @@ let addPrefixToFinalName path prefix =
let i = String.rindex path pathSeparatorChar + 1 in
let l = String.length path in
let l' = String.length prefix in
- let p = String.create (l + l') in
+ let p = Bytes.create (l + l') in
String.blit path 0 p 0 i;
String.blit prefix 0 p i l';
String.blit path i p (i + l') (l - i);
- p
+ Bytes.to_string p
with Not_found ->
assert (not (isEmpty path));
prefix ^ path
$NetBSD: patch-remote.ml,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- remote.ml~ 2009-05-29 14:00:18.000000000 +0000
+++ remote.ml
@@ -79,10 +79,10 @@ let catch_io_errors th =
type connection =
{ inputChannel : Unix.file_descr;
- inputBuffer : string;
+ inputBuffer : bytes;
mutable inputLength : int;
outputChannel : Unix.file_descr;
- outputBuffer : string;
+ outputBuffer : bytes;
mutable outputLength : int;
outputQueue : (Bytearray.t * int * int) list Queue.t;
mutable pendingOutput : bool;
@@ -107,7 +107,7 @@ let fill_inputBuffer conn =
Util.msg "grab: EOF\n"
else
Util.msg "grab: %s\n"
- (String.escaped (String.sub conn.inputBuffer 0 len)));
+ (String.escaped (Bytes.to_string (Bytes.sub conn.inputBuffer 0 len))));
if len = 0 then
lost_connection ()
else begin
@@ -122,10 +122,10 @@ let rec grab_rec conn s pos len =
grab_rec conn s pos len)
end else begin
let l = min (len - pos) conn.inputLength in
- Bytearray.blit_from_string conn.inputBuffer 0 s pos l;
+ Bytearray.blit_from_bytes conn.inputBuffer 0 s pos l;
conn.inputLength <- conn.inputLength - l;
if conn.inputLength > 0 then
- String.blit conn.inputBuffer l conn.inputBuffer 0 conn.inputLength;
+ Bytes.blit conn.inputBuffer l conn.inputBuffer 0 conn.inputLength;
if pos + l < len then
grab_rec conn s (pos + l) len
else
@@ -138,7 +138,7 @@ let grab conn s len =
grab_rec conn s 0 len
let peek_without_blocking conn =
- String.sub conn.inputBuffer 0 conn.inputLength
+ Bytes.to_string (Bytes.sub conn.inputBuffer 0 conn.inputLength)
(****)
@@ -152,11 +152,11 @@ let rec send_output conn =
>>= (fun len ->
debugV (fun() ->
Util.msg "dump: %s\n"
- (String.escaped (String.sub conn.outputBuffer 0 len)));
+ (String.escaped (Bytes.to_string (Bytes.sub conn.outputBuffer 0 len))));
emittedBytes := !emittedBytes +. float len;
conn.outputLength <- conn.outputLength - len;
if conn.outputLength > 0 then
- String.blit
+ Bytes.blit
conn.outputBuffer len conn.outputBuffer 0 conn.outputLength;
Lwt.return ()))
@@ -166,7 +166,7 @@ let rec fill_buffer_2 conn s pos len =
fill_buffer_2 conn s pos len)
else begin
let l = min (len - pos) (outputBuffer_size - conn.outputLength) in
- Bytearray.blit_to_string s pos conn.outputBuffer conn.outputLength l;
+ Bytearray.blit_to_bytes s pos conn.outputBuffer conn.outputLength l;
conn.outputLength <- conn.outputLength + l;
if pos + l < len then
fill_buffer_2 conn s (pos + l) len
@@ -302,10 +302,10 @@ let setupIO in_ch out_ch =
Unix.set_nonblock out_ch
end;
{ inputChannel = in_ch;
- inputBuffer = String.create inputBuffer_size;
+ inputBuffer = Bytes.create inputBuffer_size;
inputLength = 0;
outputChannel = out_ch;
- outputBuffer = String.create outputBuffer_size;
+ outputBuffer = Bytes.create outputBuffer_size;
outputLength = 0;
outputQueue = Queue.create ();
pendingOutput = false;
@@ -1078,7 +1078,7 @@ let openConnectionReply = function
(i1,i2,o1,o2,s,Some fdTerm,clroot,pid) ->
(fun response ->
(* FIX: should loop on write, watch for EINTR, etc. *)
- ignore(Unix.write fdTerm (response ^ "\n") 0 (String.length response + 1)))
+ ignore(Unix.write fdTerm (Bytes.of_string (response ^ "\n")) 0 (String.length response + 1)))
| _ -> (fun _ -> ())
let openConnectionEnd (i1,i2,o1,o2,s,_,clroot,pid) =
$NetBSD: patch-terminal.ml,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- terminal.ml~ 2009-05-02 02:31:27.000000000 +0000
+++ terminal.ml
@@ -208,14 +208,14 @@ let rec termInput fdTerm fdInput =
(* read a line of input *)
let msg =
let n = 1024 in (* Assume length of input from terminal < n *)
- let s = String.create n in
+ let s = Bytes.create n in
let howmany =
let rec loop() =
try Unix.read fdTerm s 0 n
with Unix.Unix_error(Unix.EINTR,_,_) -> loop() in
loop() in
if howmany <= 0 then "" else
- String.sub s 0 howmany in
+ Bytes.to_string (Bytes.sub s 0 howmany) in
let len = String.length msg in
if len = 0 then None (* the terminal has been closed *)
else if len = 2 && msg.[0] = '\r' && msg.[1] = '\n' then
@@ -227,20 +227,20 @@ let (>>=) = Lwt.bind
(* Read messages from the terminal and use the callback to get an answer *)
let handlePasswordRequests fdTerm callback =
Unix.set_nonblock fdTerm;
- let buf = String.create 10000 in
+ let buf = Bytes.create 10000 in
let rec loop () =
Lwt_unix.read fdTerm buf 0 10000 >>= (fun len ->
if len = 0 then
(* The remote end is dead *)
Lwt.return ()
else
- let query = String.sub buf 0 len in
- if query = "\r\n" then
+ let query = Bytes.sub buf 0 len in
+ if Bytes.to_string query = "\r\n" then
loop ()
else begin
- let response = callback query in
+ let response = callback (Bytes.to_string query) in
Lwt_unix.write fdTerm
- (response ^ "\n") 0 (String.length response + 1)
+ (Bytes.of_string (response ^ "\n")) 0 (String.length response + 1)
>>= (fun _ ->
loop ())
end)
$NetBSD: patch-test.ml,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- test.ml~ 2009-05-02 02:31:27.000000000 +0000
+++ test.ml
@@ -48,9 +48,9 @@ let rec remove_file_or_dir d =
let read_chan chan =
let nbytes = in_channel_length chan in
- let string = String.create nbytes in
+ let string = Bytes.create nbytes in
really_input chan string 0 nbytes;
- string
+ Bytes.to_string string
let read file =
if file = "-" then
$NetBSD: patch-transfer.ml,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- transfer.ml~ 2009-06-18 08:36:04.000000000 +0000
+++ transfer.ml
@@ -251,13 +251,13 @@ let send infd length showProgress transm
let timer = Trace.startTimer "Sending file using generic transmission" in
let bufSz = 8192 in
let bufSzFS = Uutil.Filesize.ofInt 8192 in
- let buf = String.create bufSz in
+ let buf = Bytes.create bufSz in
let q = makeQueue length in
let rec sendSlice length =
let count =
reallyRead infd buf 0
(if length > bufSzFS then bufSz else Uutil.Filesize.toInt length) in
- queueToken q showProgress transmit (STRING (buf, 0, count)) >>= (fun () ->
+ queueToken q showProgress transmit (STRING (Bytes.to_string buf, 0, count)) >>= (fun () ->
let length = Uutil.Filesize.sub length (Uutil.Filesize.ofInt count) in
if count = bufSz && length > Uutil.Filesize.zero then
sendSlice length
@@ -277,7 +277,7 @@ let rec receiveRec outfd showProgress da
let length = decodeInt2 data (pos + 1) in
if Trace.enabled "generic" then debug (fun() -> Util.msg
"receiving %d bytes\n" length);
- reallyWrite outfd (Bytearray.sub data (pos + 3) length) 0 length;
+ reallyWrite outfd (Bytes.of_string (Bytearray.sub data (pos + 3) length)) 0 length;
showProgress length;
receiveRec outfd showProgress data (pos + length + 3) maxPos
| 'E' ->
@@ -321,7 +321,7 @@ struct
and eventually handles the buffer update. *)
let blockIter infd f arg maxCount =
let bufferSize = 8192 + blockSize in
- let buffer = String.create bufferSize in
+ let buffer = Bytes.create bufferSize in
let rec iter count arg offset length =
if count = maxCount then arg else begin
let newOffset = offset + blockSize in
@@ -329,7 +329,7 @@ struct
iter (count + 1) (f buffer offset arg) newOffset length
else if offset > 0 then begin
let chunkSize = length - offset in
- String.blit buffer offset buffer 0 chunkSize;
+ Bytes.blit buffer offset buffer 0 chunkSize;
iter count arg 0 chunkSize
end else begin
let l = input infd buffer length (bufferSize - length) in
@@ -359,6 +359,7 @@ struct
debugLog (fun() -> Util.msg "block size = %d bytes\n" blockSize);
let timer = Trace.startTimer "Preprocessing old file" in
let addBlock buf offset rev_bi =
+ let buf = Bytes.to_string buf in
let cs = Checksum.substring buf offset blockSize in
let fp = Digest.substring buf offset blockSize in
(cs, fp) :: rev_bi
@@ -383,7 +384,7 @@ struct
(* For each transfer instruction, either output a string or copy one or
several blocks from the old file. *)
let rsyncDecompress infd outfd showProgress (data, pos, len) =
- let decomprBuf = String.create decomprBufSize in
+ let decomprBuf = Bytes.create decomprBufSize in
let progress = ref 0 in
let rec copy length =
if length > decomprBufSize then begin
@@ -409,7 +410,7 @@ struct
if Trace.enabled "rsynctoken" then
debugToken (fun() ->
Util.msg "decompressing string (%d bytes)\n" length);
- reallyWrite outfd (Bytearray.sub data (pos + 3) length) 0 length;
+ reallyWrite outfd (Bytes.of_string (Bytearray.sub data (pos + 3) length)) 0 length;
progress := !progress + length;
decode (pos + length + 3)
| 'B' ->
@@ -584,12 +585,12 @@ struct
logHash blockTable !hashTableLength;
(* Create the compression buffer *)
- let comprBuf = String.create comprBufSize in
+ let comprBuf = Bytes.create comprBufSize in
(* If there is data waiting to be sent, transmit it as a STRING token *)
let transmitString toBeSent offset =
if offset > toBeSent then
- transmit (STRING (comprBuf, toBeSent, offset - toBeSent))
+ transmit (STRING (Bytes.to_string comprBuf, toBeSent, offset - toBeSent))
else
return ()
in
@@ -611,7 +612,7 @@ struct
let chunkSize = length - newOffset in
if chunkSize > 0 then begin
assert(comprBufSize >= blockSize);
- String.blit comprBuf newOffset comprBuf 0 chunkSize
+ Bytes.blit comprBuf newOffset comprBuf 0 chunkSize
end;
let rem = Uutil.Filesize.sub srcLength !absolutePos in
let avail = comprBufSize - chunkSize in
@@ -636,12 +637,12 @@ struct
let cksum =
if miss then
Checksum.roll !cksumTable !checksum !cksumOutgoing
- (String.unsafe_get comprBuf (newOffset + blockSize - 1))
+ (Bytes.unsafe_get comprBuf (newOffset + blockSize - 1))
else
- Checksum.substring comprBuf newOffset blockSize
+ Checksum.substring (Bytes.to_string comprBuf) newOffset blockSize
in
checksum := cksum;
- cksumOutgoing := String.unsafe_get comprBuf newOffset;
+ cksumOutgoing := Bytes.unsafe_get comprBuf newOffset;
processBlock newOffset toBeSent length cksum
(* Try to match the current block with one existing in the old file *)
@@ -672,7 +673,7 @@ struct
-1
| (k, cs, fp) :: tl, None
when cs = checksum ->
- let fingerprint = Digest.substring comprBuf offset blockSize in
+ let fingerprint = Digest.substring (Bytes.to_string comprBuf) offset blockSize in
findBlock offset checksum entry (Some fingerprint)
| (k, cs, fp) :: tl, Some fingerprint
when (cs = checksum) && (fp = fingerprint) ->
$NetBSD: patch-uicommon.ml,v 1.1 2018/03/14 10:16:03 dholland Exp $
Fix build with ocaml 4.06.
--- uicommon.ml~ 2009-05-28 09:23:33.000000000 +0000
+++ uicommon.ml
@@ -356,16 +356,16 @@ let dangerousPathMsg dangerousPaths =
let quote s =
let len = String.length s in
- let buf = String.create (2 * len) in
+ let buf = Bytes.create (2 * len) in
let pos = ref 0 in
for i = 0 to len - 1 do
match s.[i] with
'*' | '?' | '[' | '{' | '}' | ',' | '\\' as c ->
- buf.[!pos] <- '\\'; buf.[!pos + 1] <- c; pos := !pos + 2
+ Bytes.set buf !pos '\\'; Bytes.set buf (!pos + 1) c; pos := !pos + 2
| c ->
- buf.[!pos] <- c; pos := !pos + 1
+ Bytes.set buf !pos c; pos := !pos + 1
done;
- "{" ^ String.sub buf 0 !pos ^ "}"
+ "{" ^ Bytes.to_string (Bytes.sub buf 0 !pos) ^ "}"
let ignorePath path = "Path " ^ quote (Path.toString path)