dune_lang: add KiB,MiB,GiB and TiB values

We make these the default printed values when displaying bytes. However the dune lang decoder can understand binary and decimal byte units. We also expand the test suite to account for parsing and displaying these values. Signed-off-by: Ali Caglayan <[email protected]>
ocaml · Oct 9, 2023 · 6f4560c · 6f4560c
1 parent 789d5b8
commit 6f4560c
Show file tree

Hide file tree

Showing 8 changed files with 182 additions and 21 deletions.
diff --git a/bin/cache.ml b/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

diff --git a/doc/changes/8618.md b/doc/changes/8618.md
@@ -0,0 +1 @@
+- `dune cache trim` now accepts binary byte units: `KiB`, `MiB`, etc. (#8618, @Alizter)
diff --git a/otherlibs/stdune/src/bytes_unit.ml b/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)
+;;
diff --git a/otherlibs/stdune/src/bytes_unit.mli b/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
diff --git a/otherlibs/stdune/test/bytes_unit_tests.ml b/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,17 @@ let%expect_test _ =
       1.23GB
       12.35GB
       123.46GB
-      1.23TB |}]
+      1.23TB
+      12.35TB
+      123.46TB
+      1234.57TB |}]
+;;
+
+(* Negative units get truncated but still printed as a negative. *)
+let%expect_test "Negative units" =
+  test [ -1L; -10L ];
+  [%expect {|
+    -0.00TB
+    -0.00TB
+    |}]
 ;;
diff --git a/test/blackbox-tests/test-cases/dune-cache/cache-man.t b/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)

diff --git a/test/expect-tests/dune_sexp/dune b/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)))
diff --git a/test/expect-tests/dune_sexp/dune_sexp_tests.ml b/test/expect-tests/dune_sexp/dune_sexp_tests.ml
@@ -0,0 +1,92 @@
+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 =
+  parse_and_assert ?check value
+  |> sprintf "%Lx"
+  |> Int.of_string
+  |> function
+  | 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 |}]
+;;