diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-05-31 21:59:43 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-05-31 22:39:48 +0200 |
| commit | 1a706ff5cf12202c80bcaafb77a3cab43bac6f4f (patch) | |
| tree | e263440fe6e4b985255b4bde7be5fbb0f1775526 | |
| parent | 23185ceadcb522c702cde28be2b5a7379d4ee9f1 (diff) | |
| download | guix-1a706ff5cf12202c80bcaafb77a3cab43bac6f4f.tar guix-1a706ff5cf12202c80bcaafb77a3cab43bac6f4f.tar.gz | |
base32: Use a custom error condition instead of 'misc-error'.
Suggested by Christopher Allan Webber <cwebber@dustycloud.org>.
* guix/base32.scm (&invalid-base32-character): New error condition.
(make-base32-string->bytevector): Use it instead of 'error'.
* tests/base32.scm ("&invalid-base32-character"): New test.
| -rw-r--r-- | guix/base32.scm | 21 | ||||
| -rw-r--r-- | tests/base32.scm | 10 |
2 files changed, 27 insertions, 4 deletions
diff --git a/guix/base32.scm b/guix/base32.scm index e0599dc01e..7b2e2a6712 100644 --- a/guix/base32.scm +++ b/guix/base32.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,6 +18,8 @@ (define-module (guix base32) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-60) #:use-module (rnrs bytevectors) #:use-module (ice-9 vlist) @@ -25,7 +27,11 @@ bytevector->base32-string bytevector->nix-base32-string base32-string->bytevector - nix-base32-string->bytevector)) + nix-base32-string->bytevector + &invalid-base32-character + invalid-base32-character? + invalid-base32-character-value + invalid-base32-character-string)) ;;; Commentary: ;;; @@ -264,6 +270,12 @@ starting from the right of S." s) bv)) +;; Invalid base32 character error condition when decoding base32. +(define-condition-type &invalid-base32-character &error + invalid-base32-character? + (character invalid-base32-character-value) + (string invalid-base32-character-string)) + (define (make-base32-string->bytevector base32-string-unfold base32-chars) (let ((char->value (let loop ((i 0) (v vlist-null)) @@ -276,7 +288,10 @@ starting from the right of S." "Return the binary representation of base32 string S as a bytevector." (base32-string-unfold (lambda (chr) (or (and=> (vhash-assv chr char->value) cdr) - (error "invalid base32 character" chr))) + (raise (condition + (&invalid-base32-character + (character chr) + (string s)))))) s)))) (define base32-string->bytevector diff --git a/tests/base32.scm b/tests/base32.scm index 81d242355a..dcd926f4b8 100644 --- a/tests/base32.scm +++ b/tests/base32.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,6 +21,7 @@ #:use-module (guix base32) #:use-module (guix utils) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) #:use-module (srfi srfi-64) #:use-module (ice-9 rdelim) #:use-module (ice-9 popen) @@ -77,6 +78,13 @@ ;; Examples from RFC 4648. (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar")))) +(test-equal "&invalid-base32-character" + #\e + (guard (c ((invalid-base32-character? c) + (invalid-base32-character-value c))) + (nix-base32-string->bytevector + (string-append (make-string 51 #\a) "e")))) + ;; The following test requires `nix-hash' in $PATH. (unless %have-nix-hash? (test-skip 1)) |