Skip to content

Commit

Permalink
Merge pull request #85 from psafont/changes
Browse files Browse the repository at this point in the history
xapi-stdext-std: add Listext.List.find_minimum
  • Loading branch information
psafont authored Jan 17, 2024
2 parents a8661d1 + 38f9acb commit 4cf5cbe
Show file tree
Hide file tree
Showing 6 changed files with 79 additions and 9 deletions.
4 changes: 4 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
@@ -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
Expand Down
8 changes: 4 additions & 4 deletions lib/xapi-stdext-encodings/encodings.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 === *)
Expand All @@ -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
Expand Down
4 changes: 4 additions & 0 deletions lib/xapi-stdext-std/listext.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
7 changes: 7 additions & 0 deletions lib/xapi-stdext-std/listext.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
61 changes: 58 additions & 3 deletions lib/xapi-stdext-std/listext_test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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) =
Expand Down Expand Up @@ -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
]
4 changes: 2 additions & 2 deletions lib/xapi-stdext-std/xstringext.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit 4cf5cbe

Please sign in to comment.