diff options
| -rw-r--r-- | guix/scripts/gc.scm | 30 | ||||
| -rw-r--r-- | guix/ui.scm | 33 | ||||
| -rw-r--r-- | tests/ui.scm | 25 |
3 files changed, 57 insertions, 31 deletions
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index 77ec7635de..ed16cab8f9 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -62,36 +62,6 @@ Invoke the garbage collector.\n")) (newline) (show-bug-report-information)) -(define (size->number str) - "Convert STR, a storage measurement representation such as \"1024\" or -\"1MiB\", to a number of bytes. Raise an error if STR could not be -interpreted." - (define unit-pos - (string-rindex str char-set:digit)) - - (define unit - (and unit-pos (substring str (+ 1 unit-pos)))) - - (let* ((numstr (if unit-pos - (substring str 0 (+ 1 unit-pos)) - str)) - (num (string->number numstr))) - (if num - (* num - (match unit - ("KiB" (expt 2 10)) - ("MiB" (expt 2 20)) - ("GiB" (expt 2 30)) - ("TiB" (expt 2 40)) - ("KB" (expt 10 3)) - ("MB" (expt 10 6)) - ("GB" (expt 10 9)) - ("TB" (expt 10 12)) - ("" 1) - (_ - (leave (_ "unknown unit: ~a~%") unit)))) - (leave (_ "invalid number: ~a~%") numstr)))) - (define %options ;; Specification of the command-line options. (list (option '(#\h "help") #f #f diff --git a/guix/ui.scm b/guix/ui.scm index dcad55e72e..944c9f87fa 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -43,6 +43,7 @@ show-version-and-exit show-bug-report-information string->number* + size->number show-what-to-build call-with-error-handling with-error-handling @@ -160,6 +161,38 @@ General help using GNU software: <http://www.gnu.org/gethelp/>")) (or (string->number str) (leave (_ "~a: invalid number~%") str))) +(define (size->number str) + "Convert STR, a storage measurement representation such as \"1024\" or +\"1MiB\", to a number of bytes. Raise an error if STR could not be +interpreted." + (define unit-pos + (string-rindex str char-set:digit)) + + (define unit + (and unit-pos (substring str (+ 1 unit-pos)))) + + (let* ((numstr (if unit-pos + (substring str 0 (+ 1 unit-pos)) + str)) + (num (string->number numstr))) + (unless num + (leave (_ "invalid number: ~a~%") numstr)) + + ((compose inexact->exact round) + (* num + (match unit + ("KiB" (expt 2 10)) + ("MiB" (expt 2 20)) + ("GiB" (expt 2 30)) + ("TiB" (expt 2 40)) + ("KB" (expt 10 3)) + ("MB" (expt 10 6)) + ("GB" (expt 10 9)) + ("TB" (expt 10 12)) + ("" 1) + (_ + (leave (_ "unknown unit: ~a~%") unit))))))) + (define (call-with-error-handling thunk) "Call THUNK within a user-friendly error handler." (guard (c ((package-input-error? c) diff --git a/tests/ui.scm b/tests/ui.scm index 08ee3967a8..886223ef54 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -166,6 +166,29 @@ interface, and powerful string processing.") #f (string->duration "d")) +(test-equal "size->number, bytes" + 42 + (size->number "42")) + +(test-equal "size->number, MiB" + (* 42 (expt 2 20)) + (size->number "42MiB")) + +(test-equal "size->number, GiB" + (* 3 (expt 2 30)) + (size->number "3GiB")) + +(test-equal "size->number, 1.2GiB" + (inexact->exact (round (* 1.2 (expt 2 30)))) + (size->number "1.2GiB")) + +(test-assert "size->number, invalid unit" + (catch 'quit + (lambda () + (size->number "9X")) + (lambda args + #t))) + (test-end "ui") |