Fix HEXADECIMAL->VECTOR-8B.

Now it passes

(do ((i 0 (+ i 1)))
    ((= i #x100))
  (let* ((v (random-byte-vector #x100))
         (h (vector-8b->hexadecimal v))
         (v* (hexadecimal->vector-8b h)))
    (do ((i 0 (+ i 1)))
        ((= i #x100))
      (if (not (= (vector-8b-ref v i) (vector-8b-ref v* i)))
          (error "Lose:" h)))))

diff --git a/src/runtime/string.scm b/src/runtime/string.scm
index 7bb4e664b851ad545fc3579d429704fb5b8f0b11..c2bdbc9bead1ec23ef82571b431401286fea3d83 100644 (file)
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -490,12 +490,14 @@ USA.
         (lambda ()
           (error:bad-range-argument string 'HEXADECIMAL->VECTOR-8B))))
     (define-integrable (hex-digit char)
-      (let ((d
-            (fix:- (char->integer char)
-                   (char->integer #\0))))
-       (if (not (and (fix:<= 0 d) (fix:< d 16)))
-           (lose))
-       d))
+      (let ((integer (char->integer char)))
+       (let ((numeric-digit (fix:- integer (char->integer #\0)))
+             (lowercase-digit (fix:- integer (char->integer #\a)))
+             (uppercase-digit (fix:- integer (char->integer #\A))))
+         (cond ((fix:< numeric-digit #d10) numeric-digit)
+               ((fix:< lowercase-digit 6) (fix:+ lowercase-digit #d10))
+               ((fix:< uppercase-digit 6) (fix:+ uppercase-digit #d10))
+               (else (lose))))))
     (if (not (fix:= (fix:and end 1) 0))
        (lose))
     (let ((bytes (make-vector-8b (fix:lsh end -1))))