~ruther/guix-local

1a706ff5cf12202c80bcaafb77a3cab43bac6f4f — Ludovic Courtès 10 years ago 23185ce
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.
2 files changed, 27 insertions(+), 4 deletions(-)

M guix/base32.scm
M tests/base32.scm
M guix/base32.scm => guix/base32.scm +18 -3
@@ 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

M tests/base32.scm => tests/base32.scm +9 -1
@@ 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))