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

Author: 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
@@ -27,6 +42,12 @@ let pp x =
     loop @@ conversion_table
   in
   if value = 1L
-  then Printf.sprintf "%Ld%s" x suffix
-  else Printf.sprintf "%.2f%s" (Int64.to_float x /. Int64.to_float value) suffix
+  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,23 +33,37 @@ let%expect_test _ =
     ; 12345678901L
     ; 123456789012L
     ; 1234567890123L
-    ]
-  in
-  List.iter ~f:(fun x -> Bytes_unit.pp x |> print_endline) bytes;
+    ; 12345678901234L
+    ; 123456789012345L
+    ; 1234567890123456L
+    ];
   [%expect
     {|
-      0B
-      1B
-      12B
-      123B
-      1.23kB
-      12.35kB
-      123.46kB
-      1.23MB
-      12.35MB
-      123.46MB
-      1.23GB
-      12.35GB
-      123.46GB
-      1.23TB |}]
+0 B
+1 B
+12 B
+123 B
+1.23 kB
+12.35 kB
+123.46 kB
+1.23 MB
+12.35 MB
+123.46 MB
+1.23 GB
+12.35 GB
+123.46 GB
+1.23 TB
+12.35 TB
+123.46 TB
+1234.57 TB
+|}]
+;;
+
+(* Negative units get truncated but still printed as a negative. *)
+let%expect_test "Negative units" =
+  test [ -1L; -10L ];
+  [%expect {|
+-0.00 TB
+-0.00 TB 
+|}]
 ;;

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,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 |}]
+;;