Skip to content

Commit 6f4560c

Browse files
AlizterAlizter
committed
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]>
1 parent 789d5b8 commit 6f4560c

File tree

8 files changed

+182
-21
lines changed

8 files changed

+182
-21
lines changed

‎bin/cache.ml‎

Lines changed: 15 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -25,12 +25,25 @@ let trim =
2525
Arg.(
2626
value
2727
& opt (some bytes) None
28-
& info ~docv:"BYTES" [ "trimmed-size" ] ~doc:"Size to trim from the cache.")
28+
& info
29+
~docv:"BYTES"
30+
[ "trimmed-size" ]
31+
~doc:"Size to trim from the cache. $(docv) is the same as for --size.")
2932
and+ size =
3033
Arg.(
3134
value
3235
& opt (some bytes) None
33-
& info ~docv:"BYTES" [ "size" ] ~doc:"Size to trim the cache to.")
36+
& info
37+
~docv:"BYTES"
38+
[ "size" ]
39+
~doc:
40+
(sprintf
41+
"Size to trim the cache to. $(docv) is the number of bytes followed by \
42+
a unit. Byte units can be one of %s."
43+
(String.enumerate_or
44+
(List.map
45+
~f:(fun (units, _) -> List.hd units)
46+
Bytes_unit.conversion_table))))
3447
in
3548
Log.init_disabled ();
3649
let open Result.O in

‎doc/changes/8618.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
- `dune cache trim` now accepts binary byte units: `KiB`, `MiB`, etc. (#8618, @Alizter)

‎otherlibs/stdune/src/bytes_unit.ml‎

Lines changed: 28 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,28 @@
1-
(* CR-someday amokhov: Add KiB, MiB, GiB. *)
2-
let conversion_table =
3-
[ [ "B"; "bytes" ], 1L
4-
; [ "kB"; "KB"; "kilobytes" ], 1_000L
5-
; [ "MB"; "megabytes" ], 1_000_000L
6-
; [ "GB"; "gigabytes" ], 1_000_000_000L
7-
; [ "TB"; "terabytes" ], 1_000_000_000_000L
1+
let bytes_conversion_table = [ [ "B"; "bytes" ], 1L ]
2+
3+
let rec long_power (l : int64) (n : int) : int64 =
4+
if n = 0 then 1L else Int64.mul l @@ long_power l (n - 1)
5+
;;
6+
7+
let decimal_conversion_table =
8+
[ [ "kB"; "KB"; "kilobytes" ], 1_000L
9+
; [ "MB"; "megabytes" ], long_power 1_000L 2
10+
; [ "GB"; "gigabytes" ], long_power 1_000L 3
11+
; [ "TB"; "terabytes" ], long_power 1_000L 4
812
]
913
;;
1014

15+
let binary_conversion_table =
16+
[ [ "KiB"; "KiB"; "kibibytes" ], 1024L
17+
; [ "MiB"; "mebibytes" ], long_power 1024L 2
18+
; [ "GiB"; "gibibytes" ], long_power 1024L 3
19+
; [ "TiB"; "tebibytes" ], long_power 1024L 4
20+
]
21+
;;
22+
23+
(* When printing we only use this conversion table *)
24+
let conversion_table = bytes_conversion_table @ decimal_conversion_table
25+
1126
let pp x =
1227
(* We go through the list to find the first unit that is greater than the
1328
number of bytes and take the predecessor as the units for printing. For the
@@ -30,3 +45,9 @@ let pp x =
3045
then Printf.sprintf "%Ld%s" x suffix
3146
else Printf.sprintf "%.2f%s" (Int64.to_float x /. Int64.to_float value) suffix
3247
;;
48+
49+
(* When parsing we accept all units *)
50+
let conversion_table =
51+
bytes_conversion_table @ decimal_conversion_table @ binary_conversion_table
52+
|> List.sort ~compare:(fun (_, x) (_, y) -> Ordering.of_int @@ Int64.compare x y)
53+
;;

‎otherlibs/stdune/src/bytes_unit.mli‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,8 @@
1-
(** Conversion table for byte suffixes and their corresponding [Int64.t] values.
2-
The first element of the tuple is a list of possible suffixes for the second
3-
element of the tuple which is the value. There are some static checks done
4-
on this table ensuring it is ordered and well-formed.*)
1+
(** Conversion table for decimal byte suffixes and their corresponding [Int64.t] values.
2+
The first element of the tuple is a list of possible suffixes for the second element
3+
of the tuple which is the value. There are some static checks done on this table
4+
ensuring it is ordered and well-formed.*)
55
val conversion_table : (string list * Int64.t) list
66

7+
(** [pp n] pretty-prints [n] as a decimal byte suffix. *)
78
val pp : Int64.t -> string

‎otherlibs/stdune/test/bytes_unit_tests.ml‎

Lines changed: 21 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -15,8 +15,10 @@ let () =
1515
loop Bytes_unit.conversion_table
1616
;;
1717

18-
let%expect_test _ =
19-
let bytes =
18+
let test bytes = List.iter ~f:(fun x -> Bytes_unit.pp x |> print_endline) bytes
19+
20+
let%expect_test "Testing significant digit boundaries" =
21+
test
2022
[ 0L
2123
; 1L
2224
; 12L
@@ -31,9 +33,10 @@ let%expect_test _ =
3133
; 12345678901L
3234
; 123456789012L
3335
; 1234567890123L
34-
]
35-
in
36-
List.iter ~f:(fun x -> Bytes_unit.pp x |> print_endline) bytes;
36+
; 12345678901234L
37+
; 123456789012345L
38+
; 1234567890123456L
39+
];
3740
[%expect
3841
{|
3942
0B
@@ -49,5 +52,17 @@ let%expect_test _ =
4952
1.23GB
5053
12.35GB
5154
123.46GB
52-
1.23TB |}]
55+
1.23TB
56+
12.35TB
57+
123.46TB
58+
1234.57TB |}]
59+
;;
60+
61+
(* Negative units get truncated but still printed as a negative. *)
62+
let%expect_test "Negative units" =
63+
test [ -1L; -10L ];
64+
[%expect {|
65+
-0.00TB
66+
-0.00TB
67+
|}]
5368
;;

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

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -91,10 +91,12 @@ Testing the output of dune cache trim.
9191
9292
OPTIONS
9393
--size=BYTES
94-
Size to trim the cache to.
94+
Size to trim the cache to. BYTES is the number of bytes followed
95+
by a unit. Byte units can be one of B, kB, KiB, MB, MiB, GB, GiB,
96+
TB or TiB.
9597
9698
--trimmed-size=BYTES
97-
Size to trim from the cache.
99+
Size to trim from the cache. BYTES is the same as for --size.
98100
99101
COMMON OPTIONS
100102
--help[=FMT] (default=auto)

‎test/expect-tests/dune_sexp/dune‎

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
(library
2+
(name dune_sexp_tests)
3+
(inline_tests)
4+
(libraries
5+
dune_tests_common
6+
stdune
7+
dune_sexp
8+
;; This is because of the (implicit_transitive_deps false)
9+
;; in dune-project
10+
ppx_expect.config
11+
ppx_expect.config_types
12+
ppx_expect.common
13+
base
14+
ppx_inline_test.config)
15+
(preprocess
16+
(pps ppx_expect)))

‎test/expect-tests/dune_sexp/dune_sexp_tests.ml‎

Lines changed: 92 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,92 @@
1+
open Stdune
2+
3+
let () = Dune_tests_common.init ()
4+
5+
(* Testing the parsing of byte values *)
6+
let parse_bytes value =
7+
Dune_sexp.Ast.atom_or_quoted_string Loc.none value
8+
|> Dune_sexp.Decoder.parse Dune_sexp.Decoder.bytes_unit Univ_map.empty
9+
;;
10+
11+
let rec long_power (l : int64) (n : int) : int64 =
12+
if n = 0 then 1L else Int64.mul l @@ long_power l (n - 1)
13+
;;
14+
15+
let parse_and_assert ?check value =
16+
let value = parse_bytes value in
17+
(match check with
18+
| None -> ()
19+
| Some check -> assert (value = check));
20+
value
21+
;;
22+
23+
let test_bytes ?check value = parse_and_assert ?check value |> Printf.printf "%#Ld\n"
24+
25+
(* Hack to insert underscores for hex values. Digits must only be 0-9 *)
26+
let test_bytes_hex ?check value =
27+
parse_and_assert ?check value
28+
|> sprintf "%Lx"
29+
|> Int.of_string
30+
|> function
31+
| Some x -> x |> Printf.sprintf "0x%#d\n" |> print_endline
32+
| None -> print_endline "hex value must not have letters"
33+
;;
34+
35+
(* Test parsing of integers. *)
36+
37+
let%expect_test "parsing no suffix" =
38+
try test_bytes "100" with
39+
| exn ->
40+
User_message.print (User_message.make [ Exn.pp exn ]);
41+
[%expect
42+
{|
43+
File "<none>", line 1, characters 0-0:
44+
Error: missing suffix, use one of B, kB, KiB, MB, MiB, GB, GiB, TB, TiB |}]
45+
;;
46+
47+
(* Test all suffixes. We print binary units in hex to better see output. *)
48+
49+
let%expect_test "parsing B suffix" =
50+
test_bytes "1B" ~check:(long_power 1024L 0);
51+
[%expect {| 1 |}]
52+
;;
53+
54+
let%expect_test "parsing kB suffix" =
55+
test_bytes "1kB" ~check:(long_power 1000L 1);
56+
[%expect {| 1_000 |}]
57+
;;
58+
59+
let%expect_test "parsing KiB suffix" =
60+
test_bytes_hex "1KiB" ~check:(long_power 1024L 1);
61+
[%expect {| 0x400 |}]
62+
;;
63+
64+
let%expect_test "parsing MB suffix" =
65+
test_bytes "1MB" ~check:(long_power 1000L 2);
66+
[%expect {| 1_000_000 |}]
67+
;;
68+
69+
let%expect_test "parsing MiB suffix" =
70+
test_bytes_hex "1MiB" ~check:(long_power 1024L 2);
71+
[%expect {| 0x100_000 |}]
72+
;;
73+
74+
let%expect_test "parsing GB suffix" =
75+
test_bytes "1GB" ~check:(long_power 1000L 3);
76+
[%expect {| 1_000_000_000 |}]
77+
;;
78+
79+
let%expect_test "parsing GiB suffix" =
80+
test_bytes_hex "1GiB" ~check:(long_power 1024L 3);
81+
[%expect {| 0x40_000_000 |}]
82+
;;
83+
84+
let%expect_test "parsing TB suffix" =
85+
test_bytes "1TB" ~check:(long_power 1000L 4);
86+
[%expect {| 1_000_000_000_000 |}]
87+
;;
88+
89+
let%expect_test "parsing TiB suffix" =
90+
test_bytes_hex "1TiB" ~check:(long_power 1024L 4);
91+
[%expect {| 0x10_000_000_000 |}]
92+
;;

0 commit comments

Comments
 (0)