rpm/unison
SHA256
1
0
Fork 0
forked from pool/unison
Code Pull Requests Activity
unison/Fix-warnings-raised-by-OCaml-4.08.1.patch

410 lines
14 KiB
Diff
Raw Blame History

From: Stephane Glondu <steph@glondu.net>
Date: Mon, 10 Feb 2020 13:10:23 +0100
Subject: Fix warnings raised by OCaml 4.08.1
---
src/bytearray.ml | 4 ++--
src/case.ml | 2 +-
src/fingerprint.ml | 4 ++--
src/fsmonitor/watchercommon.ml | 12 ++++++------
src/fspath.ml | 8 ++++----
src/fswatch.ml | 12 ++++++------
src/fswatchold.ml | 2 +-
src/lwt/generic/lwt_unix_impl.ml | 6 +++---
src/osx.ml | 8 ++++----
src/path.ml | 2 +-
src/transfer.ml | 2 +-
src/transport.ml | 4 ++--
src/ubase/prefs.ml | 2 +-
src/ubase/uarg.ml | 2 +-
src/ubase/util.ml | 2 +-
src/uicommon.ml | 6 +++---
src/uigtk2.ml | 10 +++++-----
src/unicode.ml | 6 +++---
src/uutil.ml | 2 +-
19 files changed, 48 insertions(+), 48 deletions(-)
--- a/bytearray.ml
+++ b/bytearray.ml
@@ -36,10 +36,10 @@ 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"
+ = "ml_blit_bigarray_to_string" [@@noalloc]
let to_string a =
let l = length a in
--- a/case.ml
+++ b/case.ml
@@ -152,7 +152,7 @@ let insensitiveOps = object
method mode = Insensitive
method modeDesc = "Latin-1 case insensitive"
method compare s s' = Util.nocase_cmp s s'
- method hash s = Uutil.hash (String.lowercase s)
+ method hash s = Uutil.hash (String.lowercase_ascii s)
method normalizePattern s = s
method caseInsensitiveMatch = true
method normalizeMatchedString s = s
--- a/fingerprint.ml
+++ b/fingerprint.ml
@@ -78,8 +78,8 @@ let toString md5 =
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
end
--- a/fsmonitor/watchercommon.ml
+++ b/fsmonitor/watchercommon.ml
@@ -52,12 +52,12 @@ let quote s =
for i = 0 to l - 1 do
let c = s.[i] in
if disallowed_char s.[i] then begin
- q.[!j] <- '%';
- q.[!j + 1] <- hex.[Char.code c lsr 4];
- q.[!j + 2] <- hex.[Char.code c land 15];
+ Bytes.set q !j '%';
+ Bytes.set q (!j + 1) hex.[Char.code c lsr 4];
+ Bytes.set q (!j + 2) hex.[Char.code c land 15];
j := !j + 3
end else begin
- q.[!j] <- c;
+ Bytes.set q !j c;
incr j
end
done;
@@ -81,10 +81,10 @@ let unquote s =
for i = 0 to l - 2 * !n - 1 do
let c = s.[!j] in
if c = '%' then begin
- u.[i] <- Char.chr ((hex_char s.[!j + 1]) lsl 4 + hex_char s.[!j + 2]);
+ Bytes.set u i (Char.chr ((hex_char s.[!j + 1]) lsl 4 + hex_char s.[!j + 2]));
j := !j + 3
end else begin
- u.[i] <- c;
+ Bytes.set u i c;
incr j
end
done;
--- a/fspath.ml
+++ b/fspath.ml
@@ -55,7 +55,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
@@ -94,8 +94,8 @@ let appleDouble (Fspath f) =
let i = 1 + String.rindex f '/' 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);
Fspath res
with Not_found ->
@@ -194,7 +194,7 @@ let concat fspath path =
let l' = String.length p 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
end
--- a/fswatch.ml
+++ b/fswatch.ml
@@ -116,12 +116,12 @@ let quote s =
for i = 0 to l - 1 do
let c = s.[i] in
if disallowed_char s.[i] then begin
- q.[!j] <- '%';
- q.[!j + 1] <- hex.[Char.code c lsr 4];
- q.[!j + 2] <- hex.[Char.code c land 15];
+ Bytes.set q !j '%';
+ Bytes.set q (!j + 1) hex.[Char.code c lsr 4];
+ Bytes.set q (!j + 2) hex.[Char.code c land 15];
j := !j + 3
end else begin
- q.[!j] <- c;
+ Bytes.set q !j c;
incr j
end
done;
@@ -145,10 +145,10 @@ let unquote s =
for i = 0 to l - 2 * !n - 1 do
let c = s.[!j] in
if c = '%' then begin
- u.[i] <- Char.chr ((hex_char s.[!j + 1]) lsl 4 + hex_char s.[!j + 2]);
+ Bytes.set u i (Char.chr ((hex_char s.[!j + 1]) lsl 4 + hex_char s.[!j + 2]));
j := !j + 3
end else begin
- u.[i] <- c;
+ Bytes.set u i c;
incr j
end
done;
--- a/fswatchold.ml
+++ b/fswatchold.ml
@@ -60,7 +60,7 @@ let watchercmd archHash root =
module StringSet= Set.Make (String)
module RootMap = Map.Make (String)
type watcherinfo = {file: System.fspath;
- mutable ch:Pervasives.in_channel option;
+ mutable ch:Stdlib.in_channel option;
chars: Buffer.t;
mutable lines: string list}
let watchers : watcherinfo RootMap.t ref = ref RootMap.empty
--- a/lwt/generic/lwt_unix_impl.ml
+++ b/lwt/generic/lwt_unix_impl.ml
@@ -337,7 +337,7 @@ let wait_outchan oc = wait_write (Unix.d
let rec input_char ic =
try
- Lwt.return (Pervasives.input_char ic)
+ Lwt.return (Stdlib.input_char ic)
with
Sys_blocked_io ->
Lwt.bind (wait_inchan ic) (fun () -> input_char ic)
@@ -346,7 +346,7 @@ let rec input_char ic =
let rec input ic s ofs len =
try
- Lwt.return (Pervasives.input ic s ofs len)
+ Lwt.return (Stdlib.input ic s ofs len)
with
Sys_blocked_io ->
Lwt.bind (wait_inchan ic) (fun () -> input ic s ofs len)
@@ -381,7 +381,7 @@ let input_line ic =
if c = '\n' then
Lwt.return ()
else begin
- !buf.[!pos] <- c;
+ Bytes.set !buf !pos c;
incr pos;
loop ()
end)
--- a/osx.ml
+++ b/osx.ml
@@ -110,9 +110,9 @@ let getID buf ofs =
let setInt4 v =
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
@@ -224,7 +224,7 @@ 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);
+ Bytes.set flags 0 (Char.chr (Char.code flags.[0] land 0xfe));
(* If the extended flags should be ignored, clear them *)
let xflags =
if Char.code xflags.[0] land 0x80 <> 0 then "\000\000" else xflags
--- a/path.ml
+++ b/path.ml
@@ -32,7 +32,7 @@ let concat p p' =
if l' = 0 then p else
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''
--- a/transfer.ml
+++ b/transfer.ml
@@ -547,7 +547,7 @@ struct
assert (h1 >= 0 && h1 < 8);
let h2 = (cs lsr 5) land (len - 1) in
let mask = 1 lsl h1 in
- filter.[h2] <- Char.chr (Char.code filter.[h2] lor mask)
+ Bytes.set filter h2 (Char.chr (Char.code filter.[h2] lor mask))
done;
filter
--- a/transport.ml
+++ b/transport.ml
@@ -183,7 +183,7 @@ let logStart () =
Printf.sprintf
"%s%s started propagating changes at %02d:%02d:%02d.%02d on %02d %s %04d\n"
(if Prefs.read Trace.terse || Prefs.read Globals.batch then "" else "\n\n")
- (String.uppercase Uutil.myNameAndVersion)
+ (String.uppercase_ascii Uutil.myNameAndVersion)
tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
(min 99 (truncate (mod_float t 1. *. 100.)))
tm.Unix.tm_mday (Util.monthname tm.Unix.tm_mon)
@@ -196,7 +196,7 @@ let logFinish () =
let m =
Printf.sprintf
"%s finished propagating changes at %02d:%02d:%02d.%02d on %02d %s %04d\n%s"
- (String.uppercase Uutil.myNameAndVersion)
+ (String.uppercase_ascii Uutil.myNameAndVersion)
tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
(min 99 (truncate (mod_float t 1. *. 100.)))
tm.Unix.tm_mday (Util.monthname tm.Unix.tm_mon)
--- a/ubase/prefs.ml
+++ b/ubase/prefs.ml
@@ -341,7 +341,7 @@ let string2bool name = function
let string2int name string =
try
int_of_string string
- with Failure "int_of_string" ->
+ with Failure _ ->
raise (Util.Fatal (name ^ " expects an integer value, but\n"
^ string ^ " is not an integer"))
--- a/ubase/uarg.ml
+++ b/ubase/uarg.ml
@@ -68,7 +68,7 @@ let parse speclist anonfun errmsg =
incr current;
while !current < l do
let ss = argv.(!current) in
- if String.length ss >= 1 & String.get ss 0 = '-' then begin
+ if String.length ss >= 1 && String.get ss 0 = '-' then begin
let args = Util.splitIntoWords ss '=' in
let s = Safelist.nth args 0 in
let arg conv mesg =
--- a/ubase/util.ml
+++ b/ubase/util.ml
@@ -27,7 +27,7 @@ let nocase_cmp a b =
if i>=minlen then compare alen blen
else
let c =
- compare (Char.lowercase(String.get a i)) (Char.lowercase(String.get b i)) in
+ compare (Char.lowercase_ascii(String.get a i)) (Char.lowercase_ascii(String.get b i)) in
if c<>0 then c else loop (i+1) in
loop 0
let nocase_eq a b = (0 = (nocase_cmp a b))
--- a/uicommon.ml
+++ b/uicommon.ml
@@ -363,9 +363,9 @@ let quote s =
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 ^ "}"
@@ -427,7 +427,7 @@ let debug = Trace.debug "startup"
(*FIX: remove when Unison version > 2.40 *)
let _ =
-Remote.registerRootCmd "_unicodeCaseSensitive_" (fun _ -> Lwt.return ())
+fun r x -> Remote.registerRootCmd "_unicodeCaseSensitive_" (fun _ -> Lwt.return ()) r x
let supportUnicodeCaseSensitive () =
if Uutil.myMajorVersion > "2.40" (* The test is correct until 2.99... *) then
Lwt.return true
--- a/uigtk2.ml
+++ b/uigtk2.ml
@@ -23,7 +23,7 @@ module Private = struct
let debug = Trace.debug "ui"
-let myNameCapitalized = String.capitalize Uutil.myName
+let myNameCapitalized = String.capitalize_ascii Uutil.myName
(**********************************************************************
LOW-LEVEL STUFF
@@ -844,7 +844,7 @@ let getSecondRoot () =
let root = getRoot() in
result := Some root;
t#destroy ()
- with Failure "int_of_string" ->
+ with Failure _ ->
if portE#text="" then
okBox ~parent:t ~title:"Error" ~typ:`ERROR ~message:"Please enter a port"
else okBox ~parent:t ~title:"Error" ~typ:`ERROR
@@ -916,7 +916,7 @@ type profileInfo = {roots:string list; l
(* ------ *)
-let profileKeymap = Array.create 10 None
+let profileKeymap = Array.make 10 None
let provideProfileKey filename k profile info =
try
@@ -935,7 +935,7 @@ let provideProfileKey filename k profile
("Error scanning profile "^ System.fspathToPrintString filename ^":\n"
^ "Value of 'key' preference must be a single digit (0-9), "
^ "not " ^ k))
- with Failure "int_of_string" -> raise (Util.Fatal
+ with Failure _ -> raise (Util.Fatal
("Error scanning profile "^ System.fspathToPrintString filename ^":\n"
^ "Value of 'key' preference must be a single digit (0-9), "
^ "not " ^ k))
@@ -1956,7 +1956,7 @@ let documentPreference ~compact ~packing
tbl#misc#set_sensitive false;
("", "", false)
in
- shortDescr#set_text (String.capitalize short);
+ shortDescr#set_text (String.capitalize_ascii short);
insertMarkup tags longDescr (formatDoc long)
(* longDescr#buffer#set_text (formatDoc long)*)
--- a/unicode.ml
+++ b/unicode.ml
@@ -22,7 +22,7 @@ exception Invalid
let fail () = raise Invalid
let get s i = Char.code (String.unsafe_get s i)
-let set s i v = String.unsafe_set s i (Char.unsafe_chr v)
+let set s i v = Bytes.unsafe_set s i (Char.unsafe_chr v)
(****)
@@ -938,7 +938,7 @@ let normalize s =
also with non-unicode strings. The optimization below assumes
a case-insensitive comparison on ASCII characters, thus we
translate the string to lowercase *)
- String.lowercase s
+ String.lowercase_ascii s
(****)
@@ -1584,7 +1584,7 @@ and compose_rec s i l v =
(v, i)
let compose s =
- try scan (0, 0) (String.copy s) 0 (String.length s) with Invalid -> s
+ try scan (0, 0) (Bytes.copy s) 0 (String.length s) with Invalid -> s
(***)
--- a/uutil.ml
+++ b/uutil.ml
@@ -34,7 +34,7 @@ let myNameAndVersion = myName ^ " " ^ my
let hash2 x y = (17 * x + 257 * y) land 0x3FFFFFFF
-external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"
+external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" [@@noalloc]
let hash x = hash_param 10 100 x
View Git Blame Copy Permalink