Fix bug #7513 (#1136)

Add tests List.compare_lengths and List.compare_length_with in tests/lib-list

Changes

@@ -188,6 +188,9 @@ Working version
 - GPR#1155: Fix a race condition with WAIT_NOHANG on Windows
   (Jérémie Dimino and David Allsopp)
 
+- PR#7513: List.compare_length_with mishandles negative numbers / overflow
+  (Fabrice Le Fessant, report by Jeremy Yallop)
+
 ### Runtime system:
 
 - GPR#938: Stack overflow detection on 64-bit Windows

stdlib/list.ml

@@ -475,9 +475,11 @@ let rec compare_lengths l1 l2 =
 ;;
 
 let rec compare_length_with l n =
-  match l, n with
-  | [], 0 -> 0
-  | [], _ -> if n > 0 then -1 else 1
-  | _, 0 -> 1
-  | _ :: l, n -> compare_length_with l (n-1)
+  match l with
+  | [] ->
+    if n = 0 then 0 else
+      if n > 0 then -1 else 1
+  | _ :: l ->
+    if n <= 0 then 1 else
+      compare_length_with l (n-1)
 ;;

testsuite/tests/lib-list/test.ml

@@ -16,6 +16,23 @@ let () =
   assert (not (List.exists (fun a -> a < 0) l));
   assert (not (List.exists (fun a -> a > 9) l));
   assert (List.exists (fun _ -> true) l);
+
+  assert (List.compare_lengths [] [] = 0);
+  assert (List.compare_lengths [1;2] ['a';'b'] = 0);
+  assert (List.compare_lengths [] [1;2] < 0);
+  assert (List.compare_lengths ['a'] [1;2] < 0);
+  assert (List.compare_lengths [1;2] [] > 0);
+  assert (List.compare_lengths [1;2] ['a'] > 0);
+
+  assert (List.compare_length_with [] 0 = 0);
+  assert (List.compare_length_with [] 1 < 0);
+  assert (List.compare_length_with [] (-1) > 0);
+  assert (List.compare_length_with [] max_int < 0);
+  assert (List.compare_length_with [] min_int > 0);
+  assert (List.compare_length_with [1] 0 > 0);
+  assert (List.compare_length_with ['1'] 1 = 0);
+  assert (List.compare_length_with ['1'] 2 < 0);
+  ()
 ;;
 
 (* Empty test case *)