feature: add KiB,MiB,GiB and TiB values

bin/cache.ml

@@ -25,12 +25,25 @@ let trim =
        Arg.(
          value
          & opt (some bytes) None
-         & info ~docv:"BYTES" [ "trimmed-size" ] ~doc:"Size to trim from the cache.")
+         & info
+             ~docv:"BYTES"
+             [ "trimmed-size" ]
+             ~doc:"Size to trim from the cache. $(docv) is the same as for --size.")
      and+ size =
        Arg.(
          value
          & opt (some bytes) None
-         & info ~docv:"BYTES" [ "size" ] ~doc:"Size to trim the cache to.")
+         & info
+             ~docv:"BYTES"
+             [ "size" ]
+             ~doc:
+               (sprintf
+                  "Size to trim the cache to. $(docv) is the number of bytes followed by \
+                   a unit. Byte units can be one of %s."
+                  (String.enumerate_or
+                     (List.map
+                        ~f:(fun (units, _) -> List.hd units)
+                        Bytes_unit.conversion_table))))
      in
      Log.init_disabled ();
      let open Result.O in

doc/changes/8618.md

@@ -0,0 +1 @@
+- `dune cache trim` now accepts binary byte units: `KiB`, `MiB`, etc. (#8618, @Alizter)

otherlibs/stdune/src/bytes_unit.ml

@@ -1,13 +1,28 @@
-(* CR-someday amokhov: Add KiB, MiB, GiB. *)
-let conversion_table =
-  [ [ "B"; "bytes" ], 1L
-  ; [ "kB"; "KB"; "kilobytes" ], 1_000L
-  ; [ "MB"; "megabytes" ], 1_000_000L
-  ; [ "GB"; "gigabytes" ], 1_000_000_000L
-  ; [ "TB"; "terabytes" ], 1_000_000_000_000L
+let bytes_conversion_table = [ [ "B"; "bytes" ], 1L ]
+
+let rec long_power (l : int64) (n : int) : int64 =
+  if n = 0 then 1L else Int64.mul l @@ long_power l (n - 1)
+;;
+
+let decimal_conversion_table =
+  [ [ "kB"; "KB"; "kilobytes" ], 1_000L
+  ; [ "MB"; "megabytes" ], long_power 1_000L 2
+  ; [ "GB"; "gigabytes" ], long_power 1_000L 3
+  ; [ "TB"; "terabytes" ], long_power 1_000L 4
   ]
 ;;
 
+let binary_conversion_table =
+  [ [ "KiB"; "KiB"; "kibibytes" ], 1024L
+  ; [ "MiB"; "mebibytes" ], long_power 1024L 2
+  ; [ "GiB"; "gibibytes" ], long_power 1024L 3
+  ; [ "TiB"; "tebibytes" ], long_power 1024L 4
+  ]
+;;
+
+(* When printing we only use this conversion table *)
+let conversion_table = bytes_conversion_table @ decimal_conversion_table
+
 let pp x =
   (* We go through the list to find the first unit that is greater than the
      number of bytes and take the predecessor as the units for printing. For the
@@ -30,3 +45,9 @@ let pp x =
   then Printf.sprintf "%Ld%s" x suffix
   else Printf.sprintf "%.2f%s" (Int64.to_float x /. Int64.to_float value) suffix
 ;;
+
+(* When parsing we accept all units *)
+let conversion_table =
+  bytes_conversion_table @ decimal_conversion_table @ binary_conversion_table
+  |> List.sort ~compare:(fun (_, x) (_, y) -> Ordering.of_int @@ Int64.compare x y)
+;;

otherlibs/stdune/src/bytes_unit.mli

@@ -1,7 +1,8 @@
-(** Conversion table for byte suffixes and their corresponding [Int64.t] values.
-    The first element of the tuple is a list of possible suffixes for the second
-    element of the tuple which is the value. There are some static checks done
-    on this table ensuring it is ordered and well-formed.*)
+(** Conversion table for decimal byte suffixes and their corresponding [Int64.t] values.
+    The first element of the tuple is a list of possible suffixes for the second element
+    of the tuple which is the value. There are some static checks done on this table
+    ensuring it is ordered and well-formed.*)
 val conversion_table : (string list * Int64.t) list
 
+(** [pp n] pretty-prints [n] as a decimal byte suffix. *)
 val pp : Int64.t -> string

otherlibs/stdune/test/bytes_unit_tests.ml

@@ -15,8 +15,10 @@ let () =
   loop Bytes_unit.conversion_table
 ;;
 
-let%expect_test _ =
-  let bytes =
+let test bytes = List.iter ~f:(fun x -> Bytes_unit.pp x |> print_endline) bytes
+
+let%expect_test "Testing significant digit boundaries" =
+  test
     [ 0L
     ; 1L
     ; 12L
@@ -31,9 +33,10 @@ let%expect_test _ =
     ; 12345678901L
     ; 123456789012L
     ; 1234567890123L
-    ]
-  in
-  List.iter ~f:(fun x -> Bytes_unit.pp x |> print_endline) bytes;
+    ; 12345678901234L
+    ; 123456789012345L
+    ; 1234567890123456L
+    ];
   [%expect
     {|
       0B
@@ -49,5 +52,18 @@ let%expect_test _ =
       1.23GB
       12.35GB
       123.46GB
-      1.23TB |}]
+      1.23TB
+      12.35TB
+      123.46TB
+      1234.57TB |}]
+;;
+
+(* CR-someday alizter: we should raise an exception here rather than giving a meaningless value. *)
+(* Negative units get truncated but still printed as a negative. *)
+let%expect_test "Negative units" =
+  test [ -1L; -10L ];
+  [%expect {|
+    -0.00TB
+    -0.00TB
+    |}]
 ;;

test/blackbox-tests/test-cases/dune-cache/cache-man.t

@@ -91,10 +91,12 @@ Testing the output of dune cache trim.
 
   OPTIONS
          --size=BYTES
-             Size to trim the cache to.
+             Size to trim the cache to. BYTES is the number of bytes followed
+             by a unit. Byte units can be one of B, kB, KiB, MB, MiB, GB, GiB,
+             TB or TiB.
 
          --trimmed-size=BYTES
-             Size to trim from the cache.
+             Size to trim from the cache. BYTES is the same as for --size.
 
   COMMON OPTIONS
          --help[=FMT] (default=auto)

test/expect-tests/dune_sexp/dune

@@ -0,0 +1,16 @@
+(library
+ (name dune_sexp_tests)
+ (inline_tests)
+ (libraries
+  dune_tests_common
+  stdune
+  dune_sexp
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  ppx_expect.common
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

test/expect-tests/dune_sexp/dune_sexp_tests.ml

@@ -0,0 +1,89 @@
+open Stdune
+
+let () = Dune_tests_common.init ()
+
+(* Testing the parsing of byte values *)
+let parse_bytes value =
+  Dune_sexp.Ast.atom_or_quoted_string Loc.none value
+  |> Dune_sexp.Decoder.parse Dune_sexp.Decoder.bytes_unit Univ_map.empty
+;;
+
+let rec long_power (l : int64) (n : int) : int64 =
+  if n = 0 then 1L else Int64.mul l @@ long_power l (n - 1)
+;;
+
+let parse_and_assert ?check value =
+  let value = parse_bytes value in
+  (match check with
+   | None -> ()
+   | Some check -> assert (value = check));
+  value
+;;
+
+let test_bytes ?check value = parse_and_assert ?check value |> Printf.printf "%#Ld\n"
+
+(* Hack to insert underscores for hex values. Digits must only be 0-9 *)
+let test_bytes_hex ?check value =
+  match parse_and_assert ?check value |> sprintf "%Lx" |> Int.of_string with
+  | Some x -> x |> Printf.sprintf "0x%#d\n" |> print_endline
+  | None -> print_endline "hex value must not have letters"
+;;
+
+(* Test parsing of integers. *)
+
+let%expect_test "parsing no suffix" =
+  try test_bytes "100" with
+  | exn ->
+    User_message.print (User_message.make [ Exn.pp exn ]);
+    [%expect
+      {|
+      File "<none>", line 1, characters 0-0:
+      Error: missing suffix, use one of B, kB, KiB, MB, MiB, GB, GiB, TB, TiB |}]
+;;
+
+(* Test all suffixes. We print binary units in hex to better see output. *)
+
+let%expect_test "parsing B suffix" =
+  test_bytes "1B" ~check:(long_power 1024L 0);
+  [%expect {| 1 |}]
+;;
+
+let%expect_test "parsing kB suffix" =
+  test_bytes "1kB" ~check:(long_power 1000L 1);
+  [%expect {| 1_000 |}]
+;;
+
+let%expect_test "parsing KiB suffix" =
+  test_bytes_hex "1KiB" ~check:(long_power 1024L 1);
+  [%expect {| 0x400 |}]
+;;
+
+let%expect_test "parsing MB suffix" =
+  test_bytes "1MB" ~check:(long_power 1000L 2);
+  [%expect {| 1_000_000 |}]
+;;
+
+let%expect_test "parsing MiB suffix" =
+  test_bytes_hex "1MiB" ~check:(long_power 1024L 2);
+  [%expect {| 0x100_000 |}]
+;;
+
+let%expect_test "parsing GB suffix" =
+  test_bytes "1GB" ~check:(long_power 1000L 3);
+  [%expect {| 1_000_000_000 |}]
+;;
+
+let%expect_test "parsing GiB suffix" =
+  test_bytes_hex "1GiB" ~check:(long_power 1024L 3);
+  [%expect {| 0x40_000_000 |}]
+;;
+
+let%expect_test "parsing TB suffix" =
+  test_bytes "1TB" ~check:(long_power 1000L 4);
+  [%expect {| 1_000_000_000_000 |}]
+;;
+
+let%expect_test "parsing TiB suffix" =
+  test_bytes_hex "1TiB" ~check:(long_power 1024L 4);
+  [%expect {| 0x10_000_000_000 |}]
+;;