diff --git a/CHANGES.md b/CHANGES.md index 581f1c96..0973572d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,7 @@ +## v4.24.0 (17-Jan-2024) +- unix: really_read now retries reads on EINTR +- std: add Listext.List.find_minimum + ## v4.23.0 (30-Oct-2023) - unix: fix blkgetsize return type mismatch (CA-382014) - unix: add function to recursively remove files diff --git a/lib/xapi-stdext-encodings/encodings.ml b/lib/xapi-stdext-encodings/encodings.ml index 62058acc..8d6d07e0 100644 --- a/lib/xapi-stdext-encodings/encodings.ml +++ b/lib/xapi-stdext-encodings/encodings.ml @@ -34,15 +34,15 @@ module UCS = struct false || (0xfdd0 <= value && value <= 0xfdef) (* case 1 *) || Int.logand 0xfffe value = 0xfffe - (* case 2 *) - [@@inline] + (* case 2 *) + [@@inline] end module XML = struct let is_illegal_control_character value = let value = Uchar.to_int value in value < 0x20 && value <> 0x09 && value <> 0x0a && value <> 0x0d - [@@inline] + [@@inline] end (* === UCS Validators === *) @@ -55,7 +55,7 @@ module UTF8_UCS_validator = struct let validate value = if (UCS.is_non_character [@inlined]) (Uchar.to_int value) then raise UCS_value_prohibited_in_UTF8 - [@@inline] + [@@inline] end module XML_UTF8_UCS_validator = struct diff --git a/lib/xapi-stdext-std/listext.ml b/lib/xapi-stdext-std/listext.ml index c3ffc20e..39ebb6c6 100644 --- a/lib/xapi-stdext-std/listext.ml +++ b/lib/xapi-stdext-std/listext.ml @@ -196,4 +196,8 @@ module List = struct aux ((upper - 1) :: accu) (upper - 1) in aux [] + + let find_minimum compare = + let min a b = if compare a b <= 0 then a else b in + function [] -> None | x :: xs -> Some (List.fold_left min x xs) end diff --git a/lib/xapi-stdext-std/listext.mli b/lib/xapi-stdext-std/listext.mli index 08435d5a..d3fcfdf7 100644 --- a/lib/xapi-stdext-std/listext.mli +++ b/lib/xapi-stdext-std/listext.mli @@ -49,6 +49,13 @@ module List : sig val iteri_right : (int -> 'a -> unit) -> 'a list -> unit (** [iteri_right f l] is {!Stdlib.List.iteri}[ f (]{!Stdlib.List.rev}[ l)] *) + (** {1 List searching} *) + + val find_minimum : ('a -> 'a -> int) -> 'a list -> 'a option + (** [find_minimum cmp l] returns the lowest element in [l] according to + the sort order of [cmp], or [None] if the list is empty. When two ore + more elements match the lowest value, the left-most is returned. *) + (** {1 Using indices to manipulate lists} *) val chop : int -> 'a list -> 'a list * 'a list diff --git a/lib/xapi-stdext-std/listext_test.ml b/lib/xapi-stdext-std/listext_test.ml index dc141f25..2ff79617 100644 --- a/lib/xapi-stdext-std/listext_test.ml +++ b/lib/xapi-stdext-std/listext_test.ml @@ -17,8 +17,8 @@ let test_list tested_f (name, case, expected) = let check () = Alcotest.(check @@ list int) name expected (tested_f case) in (name, `Quick, check) -let test_option tested_f (name, case, expected) = - let check () = Alcotest.(check @@ option int) name expected (tested_f case) in +let test_option typ tested_f (name, case, expected) = + let check () = Alcotest.(check @@ option typ) name expected (tested_f case) in (name, `Quick, check) let test_chopped_list tested_f (name, case, expected) = @@ -180,6 +180,61 @@ let test_sub = let tests = List.map test specs in ("sub", tests) +let test_find_minimum (name, pp, typ, specs) = + let test ((cmp, cmp_name), input, expected) = + let name = Printf.sprintf "%s of [%s]" cmp_name (pp input) in + test_option typ (Listext.find_minimum cmp) (name, input, expected) + in + let tests = List.map test specs in + (Printf.sprintf "find_minimum (%s)" name, tests) + +let test_find_minimum_int = + let ascending = (Int.compare, "ascending") in + let descending = ((fun a b -> Int.compare b a), "descending") in + let specs_int = + ( "int" + , (fun a -> String.concat "; " (List.map string_of_int a)) + , Alcotest.int + , [ + (ascending, [], None) + ; (ascending, [1; 2; 3; 4; 5], Some 1) + ; (ascending, [2; 3; 1; 5; 4], Some 1) + ; (descending, [], None) + ; (descending, [1; 2; 3; 4; 5], Some 5) + ; (descending, [2; 3; 1; 5; 4], Some 5) + ] + ) + in + test_find_minimum specs_int + +let test_find_minimum_tuple = + let ascending = ((fun (a, _) (b, _) -> Int.compare a b), "ascending") in + let descending = ((fun (a, _) (b, _) -> Int.compare b a), "descending") in + let specs_tuple = + ( "tuple" + , (fun a -> + String.concat "; " + (List.map (fun (a, b) -> "(" ^ string_of_int a ^ ", " ^ b ^ ")") a) + ) + , Alcotest.(pair int string) + , [ + (ascending, [(1, "fst"); (1, "snd")], Some (1, "fst")) + ; (descending, [(1, "fst"); (1, "snd")], Some (1, "fst")) + ; (ascending, [(1, "fst"); (1, "snd"); (2, "nil")], Some (1, "fst")) + ; (descending, [(1, "nil"); (2, "fst"); (2, "snd")], Some (2, "fst")) + ] + ) + in + test_find_minimum specs_tuple + let () = Alcotest.run "Listext" - [test_iteri_right; test_take; test_drop; test_chop; test_sub] + [ + test_iteri_right + ; test_take + ; test_drop + ; test_chop + ; test_sub + ; test_find_minimum_int + ; test_find_minimum_tuple + ] diff --git a/lib/xapi-stdext-std/xstringext.ml b/lib/xapi-stdext-std/xstringext.ml index 8f5b7130..7fb16aba 100644 --- a/lib/xapi-stdext-std/xstringext.ml +++ b/lib/xapi-stdext-std/xstringext.ml @@ -74,8 +74,8 @@ module String = struct let aux h t = ( if List.mem_assoc h rules then List.assoc h rules - else - of_char h + else + of_char h ) :: t in