From 1277df09fd0d514458c083db6f63584157fc206d Mon Sep 17 00:00:00 2001
From: jgarcia <jgarcia>
Date: Wed, 1 Nov 2006 17:45:08 +0000
Subject: [PATCH] DIGIT-CHAR complains when passed an invalid radix.

---
 src/CHANGELOG     |  4 ++--
 src/c/character.d | 32 ++++++++++++++++++++++----------
 2 files changed, 24 insertions(+), 12 deletions(-)

diff --git a/src/CHANGELOG b/src/CHANGELOG
index c6d4dc4a5..4589a12eb 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -145,8 +145,8 @@ ECL 1.0:
    SCALE-FLOAT, FLOAT-RADIX, FLOAT-DIGITS, INTEGER-DECODE-FLOAT, REALPART,
    IMAGPART, COMPLEX, etc
 
- - DIGIT-CHAR-P will signal an error if the radix is not an integer value
-   between 2 and 36, both included.
+ - DIGIT-CHAR-P and DIGIT-CHAR will signal an error if the radix is not an
+   integer value between 2 and 36, both included.
 
  - C functions which disappear: si_set_compiled_function_name(),
    si_extended_string_concatenate(), assert_type_string(),
diff --git a/src/c/character.d b/src/c/character.d
index 3b3b7fc1c..9f2d04291 100644
--- a/src/c/character.d
+++ b/src/c/character.d
@@ -379,18 +379,30 @@ cl_char_downcase(cl_object c)
 	@(return (isupper(code) ? CODE_CHAR(tolower(code)) : c))
 }
 
-@(defun digit_char (w &optional (r MAKE_FIXNUM(10)))
-	cl_object output;
-@
-	/* INV: fixnnint() checks the types of `w' and `r' */
-	if (type_of(w) == t_bignum) {
-		output = Cnil;
-	} else {
-		int dw = ecl_digit_char(fixnnint(w), fixnnint(r));
-		output = (dw < 0)? Cnil : CODE_CHAR(dw);
+@(defun digit_char (weight &optional (radix MAKE_FIXNUM(10)))
+@ {
+	cl_fixnum basis = ecl_fixnum_in_range(@'digit-char',"radix",radix,2,36);
+	cl_object output = Cnil;
+  AGAIN:
+	switch (type_of(weight)) {
+	case t_fixnum: {
+		cl_fixnum value = fix(weight);
+		if (value >= 0) {
+			int dw = ecl_digit_char(value, basis);
+			if (dw >= 0) {
+				output = CODE_CHAR(dw);
+			}
+		}
+		break;
+	}
+	case t_bignum:
+		break;
+	default:
+		weight = ecl_type_error(@'digit-char',"weight",weight,@'integer');
+		goto AGAIN;
 	}
 	@(return output)
-@)
+} @)
 
 short
 ecl_digit_char(cl_fixnum w, cl_fixnum r)