Merge pull request #85 from psafont/changes

xapi-stdext-std: add Listext.List.find_minimum

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

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

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

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

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
+    ]

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