03/03: base32: Use a custom error condition instead of 'misc-error'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 1a706ff5cf12202c80bcaafb77a3cab43bac6f4f
Author: Ludovic Courtès <address@hidden>
Date:   Sun May 31 21:59:43 2015 +0200

    base32: Use a custom error condition instead of 'misc-error'.
    
    Suggested by Christopher Allan Webber <address@hidden>.
    
    * 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.
---
 guix/base32.scm  |   21 ++++++++++++++++++---
 tests/base32.scm |   10 +++++++++-
 2 files changed, 27 insertions(+), 4 deletions(-)

diff --git a/guix/base32.scm b/guix/base32.scm
index e0599dc..7b2e2a6 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 <address@hidden>
+;;; Copyright © 2012, 2015 Ludovic Courtès <address@hidden>
 ;;;
 ;;; 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 81d2423..dcd926f 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 <address@hidden>
+;;; Copyright © 2012, 2013, 2015 Ludovic Courtès <address@hidden>
 ;;;
 ;;; 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))