Author: yamakenz
Date: Fri May 18 22:52:20 2007
New Revision: 4550
Added:
sigscheme-trunk/test/test-char-pred.scm
Modified:
sigscheme-trunk/NEWS
sigscheme-trunk/QALog
sigscheme-trunk/doc/spec.txt
sigscheme-trunk/src/char.c
sigscheme-trunk/src/read.c
sigscheme-trunk/src/sigschemeinternal.h
sigscheme-trunk/test/test-char-cmp.scm
sigscheme-trunk/test/test-char.scm
Log:
[QA] char.c
* src/sigschemeinternal.h
- (ICHAR_SINGLEBYTEP, ICHAR_VALID_UNICODEP): New macro
- (ICHAR_WHITESPACEP): Add comment about specification
* src/char.c
- (scm_p_integer2char):
* Fix invalid Unicode character acception
* Accept any non-ASCII singlebyte values on integer->char when
!SCM_USE_MULTIBYTE_CHAR
- (scm_p_char_upcase, scm_p_char_downcase): Cosmetic change
* src/read.c
- (parse_unicode_sequence): Simplify with ICHAR_VALID_UNICODEP()
* test/test-char-pred.scm
- New file
- Add tests for R5RS char classification predicates
- All tests have been passed
* test/test-char.scm
- Remove obsolete tests
- Add tests for char?, char-upcase, char-downcase, char->integer,
integer->char, R6RS named chars case-sensitivity
* test/test-char-cmp.scm
- Update comments about R6RS chars
* doc/spec.txt
- Add subsections "Non-ASCII charcter acceptance" and "Whitespace
charcters"
- Update some character-related specs
* NEWS
* QALog
- Update
Modified: sigscheme-trunk/NEWS
==============================================================================
--- sigscheme-trunk/NEWS (original)
+++ sigscheme-trunk/NEWS Fri May 18 22:52:20 2007
@@ -11,7 +11,12 @@
- Make Shift_JIS encoding name (CES) and Unicode CCS names of the codec API
proper
+ - Accept any non-ASCII singlebyte values on integer->char when
+ !SCM_USE_MULTIBYTE_CHAR
+
* Fixes
+
+ - Fix invalid Unicode character acception on integer->char
* Others
Modified: sigscheme-trunk/QALog
==============================================================================
--- sigscheme-trunk/QALog (original)
+++ sigscheme-trunk/QALog Fri May 18 22:52:20 2007
@@ -258,7 +258,7 @@
yyyyyyyy r5rs number-io.c
yyyy yyy r5rs list.c
yyyy yyy r5rs deep-cadrs.c
- r5rs char.c
+yyyy yy r5rs char.c
yyyy yyy r5rs string.c
r5rs string-procedure.c
r5rs vector.c
@@ -530,7 +530,7 @@
file: sigschemeinternal.h
category: core
-spec by eyes: [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED],
[EMAIL PROTECTED]
+spec by eyes: [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED],
[EMAIL PROTECTED], [EMAIL PROTECTED]
spec by tests:
general review: [EMAIL PROTECTED]
64-bit by eyes: [EMAIL PROTECTED]
@@ -728,7 +728,7 @@
file: read.c
category: semicore
-spec by eyes: [EMAIL PROTECTED], [EMAIL PROTECTED]
+spec by eyes: [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED]
spec by tests: [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED],
[EMAIL PROTECTED]
general review: [EMAIL PROTECTED], [EMAIL PROTECTED]
64-bit by eyes: [EMAIL PROTECTED]
@@ -838,13 +838,13 @@
file: char.c
category: r5rs
-spec by eyes:
-spec by tests:
-general review:
-64-bit by eyes:
+spec by eyes: [EMAIL PROTECTED]
+spec by tests: [EMAIL PROTECTED]
+general review: [EMAIL PROTECTED]
+64-bit by eyes: [EMAIL PROTECTED]
64-bit by tests:
-coding style:
-normal case tests:
+coding style: [EMAIL PROTECTED]
+normal case tests: [EMAIL PROTECTED]
corner case tests:
file: string.c
@@ -1081,6 +1081,10 @@
Log
---
+2007-05-19 YamaKen <yamaken AT bp.iij4u.or.jp>
+ * char.c
+ - QA done @r4550 with test-char{,-pred}.scm
+
2007-04-13 YamaKen <yamaken AT bp.iij4u.or.jp>
* write.c
* format.c
Modified: sigscheme-trunk/doc/spec.txt
==============================================================================
--- sigscheme-trunk/doc/spec.txt (original)
+++ sigscheme-trunk/doc/spec.txt Fri May 18 22:52:20 2007
@@ -136,11 +136,44 @@
processing specified in R6RS nor other non-Unicode multibyte character
processing are supported in such procedures/predicates.
+Non-ASCII charcter acceptance
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+`integer->char` only accepts valid characters of current character codec. If
+no multibyte character codec is enabled on configuration, it accepts 0-255.
+
+If no multibyte character codec is enabled on configuration, character
+literal only covers ASCII.
+
+If UTF-8 codec is enabled and is the current codec, character literal covers
+all valid Unicode charcters.
+
+Whitespace charcters
+~~~~~~~~~~~~~~~~~~~~
+SigScheme treats vertical tab (0x0b) as a white space charcter although
+R5RS `char-whitespace?` does not cover it.
+
+----------------------------------------------------------------
+ R5RS: 6.3.4 Characters
+
+ The whitespace characters are space, tab, line feed, form feed, and
+ carriage return.
+----------------------------------------------------------------
+
+----------------------------------------------------------------
+ R6RS Standard Libraries: 1.1 Characters
+
+ A character is whitespace if it is in one of the space, line, or
+ paragraph separator categories (Zs, Zl or Zp), or if is U+0009
+ (Horizontal tabulation), U+000A (Line feed), U+000B (Vertical
+ tabulation), U+000C (Form feed), or U+000D (Carriage return).
+----------------------------------------------------------------
+
Case-insensitive character comparison
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SigScheme's case-insensitive comparison conforms to the foldcase'ed
-comparison described in SRFI-75 and SRFI-13, although R5RS does not specify
+comparison described in R6RS and SRFI-13, although R5RS does not specify
comparison between alphabetic and non-alphabetic char.
See the description in sigschemeinternal.h for further details.
@@ -581,6 +614,7 @@
- Supports Unicode identifiers (but lacks character category validation)
- Supports all named chars such as #\backspace, #\esc, and #\nul
- Quoted-symbol by vertical bar (such as '|-symbol|) is not supported yet
+ - Invalidly accepts non-all-lower-case character names such as #\Tab and #TAB
TODOs
^^^^^
Modified: sigscheme-trunk/src/char.c
==============================================================================
--- sigscheme-trunk/src/char.c (original)
+++ sigscheme-trunk/src/char.c Fri May 18 22:52:20 2007
@@ -125,6 +125,8 @@
CHAR_CMP_BODY(>=, ch1, ch2);
}
+#undef CHAR_CMP_BODY
+
#define CHAR_CI_CMP_BODY(op, ch1, ch2) \
do { \
scm_ichar_t val1, val2; \
@@ -178,7 +180,6 @@
CHAR_CI_CMP_BODY(>=, ch1, ch2);
}
-#undef CHAR_CMP_BODY
#undef CHAR_CI_CMP_BODY
SCM_EXPORT ScmObj
@@ -256,6 +257,14 @@
return MAKE_INT(SCM_CHAR_VALUE(ch));
}
+/*
+ * R6RS: 9.13 Characters
+ *
+ * procedure: (integer->char sv)
+ *
+ * Sv must be a Unicode scalar value, i.e. a non-negative exact integer in
+ * [0, #xD7FF] ∪ [#xE000, #x10FFFF].
+ */
SCM_EXPORT ScmObj
scm_p_integer2char(ScmObj n)
{
@@ -266,11 +275,13 @@
val = SCM_INT_VALUE(n);
#if SCM_USE_MULTIBYTE_CHAR
- if (!SCM_CHARCODEC_CHAR_LEN(scm_current_char_codec, val))
+ if ((SCM_CHARCODEC_CCS(scm_current_char_codec) == SCM_CCS_UNICODE
+ && !ICHAR_VALID_UNICODEP(val))
+ || !SCM_CHARCODEC_CHAR_LEN(scm_current_char_codec, val))
#else
- if (!ICHAR_ASCIIP(val))
+ if (!ICHAR_SINGLEBYTEP(val)) /* accepts ISO-8859-1 loosely */
#endif
- ERR("invalid char value: #x~MX", SCM_INT_VALUE(n));
+ ERR("invalid char value: #x~MX", val);
return MAKE_CHAR((scm_ichar_t)val);
}
@@ -284,9 +295,8 @@
ENSURE_CHAR(ch);
val = SCM_CHAR_VALUE(ch);
- ch = MAKE_CHAR(ICHAR_UPCASE(val));
- return ch;
+ return MAKE_CHAR(ICHAR_UPCASE(val));
}
SCM_EXPORT ScmObj
@@ -298,7 +308,6 @@
ENSURE_CHAR(ch);
val = SCM_CHAR_VALUE(ch);
- ch = MAKE_CHAR(ICHAR_DOWNCASE(val));
- return ch;
+ return MAKE_CHAR(ICHAR_DOWNCASE(val));
}
Modified: sigscheme-trunk/src/read.c
==============================================================================
--- sigscheme-trunk/src/read.c (original)
+++ sigscheme-trunk/src/read.c Fri May 18 22:52:20 2007
@@ -727,7 +727,7 @@
/* R6RS: 3.2.6 Strings
* the sequence of <digit 16>s forms a hexadecimal number between 0 and
* #x10FFFF excluding the range [#xD800, #xDFFF] */
- if ((0xd800 <= c && c <= 0xdfff) || 0x10ffff < c)
+ if (!ICHAR_VALID_UNICODEP(c))
ERR("invalid Unicode value: 0x~MX", (scm_int_t)c);
return c;
Modified: sigscheme-trunk/src/sigschemeinternal.h
==============================================================================
--- sigscheme-trunk/src/sigschemeinternal.h (original)
+++ sigscheme-trunk/src/sigschemeinternal.h Fri May 18 22:52:20 2007
@@ -462,10 +462,30 @@
/*=======================================
Characters
=======================================*/
+/* FIXME: support R6RS Unicode */
+
/* accepts SCM_ICHAR_EOF */
/* assumes ASCII */
-#define ICHAR_ASCIIP(c) (0 <= (c) && (c) <= 127)
+#define ICHAR_ASCIIP(c) (0 <= (c) && (c) <= 127)
+#define ICHAR_SINGLEBYTEP(c) (0 <= (c) && (c) <= 255)
+#define ICHAR_VALID_UNICODEP(c) ((0 <= (c) && (c) <= 0xd7ff) \
+ || (0xe000 <= (c) && (c) <= 0x10ffff))
+
#define ICHAR_CONTROLP(c) ((0 <= (c) && (c) <= 31) || (c) == 127)
+/*
+ * SigScheme treats vertical tab (0x0b) as a white space charcter although
+ * R5RS char-whitespace? does not cover it.
+ *
+ * R5RS: 6.3.4 Characters
+ * The whitespace characters are space, tab, line feed, form feed, and
+ * carriage return.
+ *
+ * R6RS Standard Libraries: 1.1 Characters
+ * A character is whitespace if it is in one of the space, line, or
+ * paragraph separator categories (Zs, Zl or Zp), or if is U+0009
+ * (Horizontal tabulation), U+000A (Line feed), U+000B (Vertical
+ * tabulation), U+000C (Form feed), or U+000D (Carriage return).
+ */
#define ICHAR_WHITESPACEP(c) ((c) == ' ' || ('\t' <= (c) && (c) <= '\r'))
#define ICHAR_NUMERICP(c) ('0' <= (c) && (c) <= '9')
#define ICHAR_HEXA_NUMERICP(c) (ICHAR_NUMERICP(c) \
@@ -494,7 +514,6 @@
* http://www.r6rs.org/document/lib-html/r6rs-lib-Z-H-3.html#node_sec_1.1
* - "Case mapping and case-folding" and "Comparison" section of SRFI-13
*/
-/* FIXME: support non-ASCII chars */
#define ICHAR_DOWNCASE(c) (ICHAR_UPPER_CASEP(c) ? (c) + ('a' - 'A') : (c))
#define ICHAR_UPCASE(c) (ICHAR_LOWER_CASEP(c) ? (c) - ('a' - 'A') : (c))
/* foldcase for case-insensitive character comparison is done by downcase as
Modified: sigscheme-trunk/test/test-char-cmp.scm
==============================================================================
--- sigscheme-trunk/test/test-char-cmp.scm (original)
+++ sigscheme-trunk/test/test-char-cmp.scm Fri May 18 22:52:20 2007
@@ -39,7 +39,7 @@
(define tn test-name)
;; SigScheme's case-insensitive comparison conforms to the foldcase'ed
-;; comparison described in SRFI-75 and SRFI-13, although R5RS does not specify
+;; comparison described in R6RS and SRFI-13, although R5RS does not specify
;; comparison between alphabetic and non-alphabetic char.
;;
;; This specification is needed to produce natural result on sort functions
@@ -52,7 +52,8 @@
;;
;; See also:
;;
-;; - Description around 'char-foldcase' in SRFI-75
+;; - Description around 'char-foldcase' in R6RS (R5.92) Standard Libraries
+;; http://www.r6rs.org/document/lib-html/r6rs-lib-Z-H-3.html#node_sec_1.1
;; - "Case mapping and case-folding" and "Comparison" section of SRFI-13
;; char=?
Added: sigscheme-trunk/test/test-char-pred.scm
==============================================================================
--- (empty file)
+++ sigscheme-trunk/test/test-char-pred.scm Fri May 18 22:52:20 2007
@@ -0,0 +1,208 @@
+#! /usr/bin/env sscm -C UTF-8
+
+;; Filename : test-char-pred.scm
+;; About : unit test for R5RS char classification predicates
+;;
+;; Copyright (c) 2007 SigScheme Project <uim AT freedesktop.org>
+;;
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+;; 3. Neither the name of authors nor the names of its contributors
+;; may be used to endorse or promote products derived from this software
+;; without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+;; IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+;; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(load "./test/unittest.scm")
+
+(if (not (symbol-bound? 'char-alphabetic?))
+ (test-skip "R5RS characters is not enabled"))
+
+(define tn test-name)
+
+(tn "char-alphabetic?")
+(assert-false (tn) (char-alphabetic? #\x00))
+(assert-false (tn) (char-alphabetic? #\newline))
+(assert-false (tn) (char-alphabetic? #\space))
+(assert-false (tn) (char-alphabetic? #\x09)) ;; horizontal tab (#\tab)
+(assert-false (tn) (char-alphabetic? #\x0b)) ;; vertical tab (#\vtab)
+(assert-false (tn) (char-alphabetic? #\x0c)) ;; form feed (#\page)
+(assert-false (tn) (char-alphabetic? #\x0d)) ;; carriage return (#\return)
+(assert-false (tn) (char-alphabetic? #\!))
+(assert-false (tn) (char-alphabetic? #\0))
+(assert-false (tn) (char-alphabetic? #\9))
+(assert-true (tn) (char-alphabetic? #\A))
+(assert-true (tn) (char-alphabetic? #\B))
+(assert-true (tn) (char-alphabetic? #\Z))
+(assert-false (tn) (char-alphabetic? #\_))
+(assert-true (tn) (char-alphabetic? #\a))
+(assert-true (tn) (char-alphabetic? #\b))
+(assert-true (tn) (char-alphabetic? #\z))
+(assert-false (tn) (char-alphabetic? #\~))
+(assert-false (tn) (char-alphabetic? #\x7f))
+(tn "char-alphabetic? non-ASCII")
+;; SigScheme currently does not support non-ASCII charcter classification
+(assert-false (tn) (char-alphabetic? #\xa0)) ;; U+00A0 NO-BREAK SPACE
+(assert-false (tn) (char-alphabetic? #\xff)) ;; U+00FF LATIN SMALL LETTER Y
WITH DIAERESIS
+(assert-false (tn) (char-alphabetic? #\x2028)) ;; U+2028 LINE SEPARATOR
+(assert-false (tn) (char-alphabetic? #\x2029)) ;; U+2029 PARAGRAPH SEPARATOR
+(assert-false (tn) (char-alphabetic? #\ )) ;; U+3000 IDEOGRAPHIC SPACE
+(assert-false (tn) (char-alphabetic? #\あ)) ;; U+3042 HIRAGANA LETTER A
+(assert-false (tn) (char-alphabetic? #\！)) ;; U+FF01 FULLWIDTH EXCLAMATION
MARK
+(assert-false (tn) (char-alphabetic? #\０)) ;; U+FF10 FULLWIDTH DIGIT ZERO
+(assert-false (tn) (char-alphabetic? #\Ａ)) ;; U+FF21 FULLWIDTH LATIN
CAPITAL LETTER A
+(assert-false (tn) (char-alphabetic? #\ａ)) ;; U+FF41 FULLWIDTH LATIN SMALL
LETTER A
+
+(tn "char-numeric?")
+(assert-false (tn) (char-numeric? #\x00))
+(assert-false (tn) (char-numeric? #\newline))
+(assert-false (tn) (char-numeric? #\space))
+(assert-false (tn) (char-numeric? #\x09)) ;; horizontal tab (#\tab)
+(assert-false (tn) (char-numeric? #\x0b)) ;; vertical tab (#\vtab)
+(assert-false (tn) (char-numeric? #\x0c)) ;; form feed (#\page)
+(assert-false (tn) (char-numeric? #\x0d)) ;; carriage return (#\return)
+(assert-false (tn) (char-numeric? #\!))
+(assert-true (tn) (char-numeric? #\0))
+(assert-true (tn) (char-numeric? #\9))
+(assert-false (tn) (char-numeric? #\A))
+(assert-false (tn) (char-numeric? #\B))
+(assert-false (tn) (char-numeric? #\Z))
+(assert-false (tn) (char-numeric? #\_))
+(assert-false (tn) (char-numeric? #\a))
+(assert-false (tn) (char-numeric? #\b))
+(assert-false (tn) (char-numeric? #\z))
+(assert-false (tn) (char-numeric? #\~))
+(assert-false (tn) (char-numeric? #\x7f))
+(tn "char-numeric? non-ASCII")
+;; SigScheme currently does not support non-ASCII charcter classification
+(assert-false (tn) (char-numeric? #\xa0)) ;; U+00A0 NO-BREAK SPACE
+(assert-false (tn) (char-numeric? #\xff)) ;; U+00FF LATIN SMALL LETTER Y
WITH DIAERESIS
+(assert-false (tn) (char-numeric? #\x2028)) ;; U+2028 LINE SEPARATOR
+(assert-false (tn) (char-numeric? #\x2029)) ;; U+2029 PARAGRAPH SEPARATOR
+(assert-false (tn) (char-numeric? #\ )) ;; U+3000 IDEOGRAPHIC SPACE
+(assert-false (tn) (char-numeric? #\あ)) ;; U+3042 HIRAGANA LETTER A
+(assert-false (tn) (char-numeric? #\！)) ;; U+FF01 FULLWIDTH EXCLAMATION
MARK
+(assert-false (tn) (char-numeric? #\０)) ;; U+FF10 FULLWIDTH DIGIT ZERO
+(assert-false (tn) (char-numeric? #\Ａ)) ;; U+FF21 FULLWIDTH LATIN CAPITAL
LETTER A
+(assert-false (tn) (char-numeric? #\ａ)) ;; U+FF41 FULLWIDTH LATIN SMALL
LETTER A
+
+(tn "char-whitespace?")
+(assert-false (tn) (char-whitespace? #\x00))
+(assert-true (tn) (char-whitespace? #\newline))
+(assert-true (tn) (char-whitespace? #\space))
+(assert-true (tn) (char-whitespace? #\x09)) ;; horizontal tab (#\tab)
+(assert-true (tn) (char-whitespace? #\x0b)) ;; vertical tab (#\vtab)
+(assert-true (tn) (char-whitespace? #\x0c)) ;; form feed (#\page)
+(assert-true (tn) (char-whitespace? #\x0d)) ;; carriage return (#\return)
+(assert-false (tn) (char-whitespace? #\!))
+(assert-false (tn) (char-whitespace? #\0))
+(assert-false (tn) (char-whitespace? #\9))
+(assert-false (tn) (char-whitespace? #\A))
+(assert-false (tn) (char-whitespace? #\B))
+(assert-false (tn) (char-whitespace? #\Z))
+(assert-false (tn) (char-whitespace? #\_))
+(assert-false (tn) (char-whitespace? #\a))
+(assert-false (tn) (char-whitespace? #\b))
+(assert-false (tn) (char-whitespace? #\z))
+(assert-false (tn) (char-whitespace? #\~))
+(assert-false (tn) (char-whitespace? #\x7f))
+(tn "char-whitespace? non-ASCII")
+;; SigScheme currently does not support non-ASCII charcter classification
+(assert-false (tn) (char-whitespace? #\xa0)) ;; U+00A0 NO-BREAK SPACE
+(assert-false (tn) (char-whitespace? #\xff)) ;; U+00FF LATIN SMALL LETTER Y
WITH DIAERESIS
+(assert-false (tn) (char-whitespace? #\x2028)) ;; U+2028 LINE SEPARATOR
+(assert-false (tn) (char-whitespace? #\x2029)) ;; U+2029 PARAGRAPH SEPARATOR
+(assert-false (tn) (char-whitespace? #\ )) ;; U+3000 IDEOGRAPHIC SPACE
+(assert-false (tn) (char-whitespace? #\あ)) ;; U+3042 HIRAGANA LETTER A
+(assert-false (tn) (char-whitespace? #\！)) ;; U+FF01 FULLWIDTH EXCLAMATION
MARK
+(assert-false (tn) (char-whitespace? #\０)) ;; U+FF10 FULLWIDTH DIGIT ZERO
+(assert-false (tn) (char-whitespace? #\Ａ)) ;; U+FF21 FULLWIDTH LATIN
CAPITAL LETTER A
+(assert-false (tn) (char-whitespace? #\ａ)) ;; U+FF41 FULLWIDTH LATIN SMALL
LETTER A
+
+(tn "char-upper-case?")
+(assert-false (tn) (char-upper-case? #\x00))
+(assert-false (tn) (char-upper-case? #\newline))
+(assert-false (tn) (char-upper-case? #\space))
+(assert-false (tn) (char-upper-case? #\x09)) ;; horizontal tab (#\tab)
+(assert-false (tn) (char-upper-case? #\x0b)) ;; vertical tab (#\vtab)
+(assert-false (tn) (char-upper-case? #\x0c)) ;; form feed (#\page)
+(assert-false (tn) (char-upper-case? #\x0d)) ;; carriage return (#\return)
+(assert-false (tn) (char-upper-case? #\!))
+(assert-false (tn) (char-upper-case? #\0))
+(assert-false (tn) (char-upper-case? #\9))
+(assert-true (tn) (char-upper-case? #\A))
+(assert-true (tn) (char-upper-case? #\B))
+(assert-true (tn) (char-upper-case? #\Z))
+(assert-false (tn) (char-upper-case? #\_))
+(assert-false (tn) (char-upper-case? #\a))
+(assert-false (tn) (char-upper-case? #\b))
+(assert-false (tn) (char-upper-case? #\z))
+(assert-false (tn) (char-upper-case? #\~))
+(assert-false (tn) (char-upper-case? #\x7f))
+(tn "char-upper-case? non-ASCII")
+;; SigScheme currently does not support non-ASCII charcter classification
+(assert-false (tn) (char-upper-case? #\xa0)) ;; U+00A0 NO-BREAK SPACE
+(assert-false (tn) (char-upper-case? #\xff)) ;; U+00FF LATIN SMALL LETTER Y
WITH DIAERESIS
+(assert-false (tn) (char-upper-case? #\x2028)) ;; U+2028 LINE SEPARATOR
+(assert-false (tn) (char-upper-case? #\x2029)) ;; U+2029 PARAGRAPH SEPARATOR
+(assert-false (tn) (char-upper-case? #\ )) ;; U+3000 IDEOGRAPHIC SPACE
+(assert-false (tn) (char-upper-case? #\あ)) ;; U+3042 HIRAGANA LETTER A
+(assert-false (tn) (char-upper-case? #\！)) ;; U+FF01 FULLWIDTH EXCLAMATION
MARK
+(assert-false (tn) (char-upper-case? #\０)) ;; U+FF10 FULLWIDTH DIGIT ZERO
+(assert-false (tn) (char-upper-case? #\Ａ)) ;; U+FF21 FULLWIDTH LATIN
CAPITAL LETTER A
+(assert-false (tn) (char-upper-case? #\ａ)) ;; U+FF41 FULLWIDTH LATIN SMALL
LETTER A
+
+(tn "char-lower-case?")
+(assert-false (tn) (char-lower-case? #\x00))
+(assert-false (tn) (char-lower-case? #\newline))
+(assert-false (tn) (char-lower-case? #\space))
+(assert-false (tn) (char-lower-case? #\x09)) ;; horizontal tab (#\tab)
+(assert-false (tn) (char-lower-case? #\x0b)) ;; vertical tab (#\vtab)
+(assert-false (tn) (char-lower-case? #\x0c)) ;; form feed (#\page)
+(assert-false (tn) (char-lower-case? #\x0d)) ;; carriage return (#\return)
+(assert-false (tn) (char-lower-case? #\!))
+(assert-false (tn) (char-lower-case? #\0))
+(assert-false (tn) (char-lower-case? #\9))
+(assert-false (tn) (char-lower-case? #\A))
+(assert-false (tn) (char-lower-case? #\B))
+(assert-false (tn) (char-lower-case? #\Z))
+(assert-false (tn) (char-lower-case? #\_))
+(assert-true (tn) (char-lower-case? #\a))
+(assert-true (tn) (char-lower-case? #\b))
+(assert-true (tn) (char-lower-case? #\z))
+(assert-false (tn) (char-lower-case? #\~))
+(assert-false (tn) (char-lower-case? #\x7f))
+(tn "char-lower-case? non-ASCII")
+;; SigScheme currently does not support non-ASCII charcter classification
+(assert-false (tn) (char-lower-case? #\xa0)) ;; U+00A0 NO-BREAK SPACE
+(assert-false (tn) (char-lower-case? #\xff)) ;; U+00FF LATIN SMALL LETTER Y
WITH DIAERESIS
+(assert-false (tn) (char-lower-case? #\x2028)) ;; U+2028 LINE SEPARATOR
+(assert-false (tn) (char-lower-case? #\x2029)) ;; U+2029 PARAGRAPH SEPARATOR
+(assert-false (tn) (char-lower-case? #\ )) ;; U+3000 IDEOGRAPHIC SPACE
+(assert-false (tn) (char-lower-case? #\あ)) ;; U+3042 HIRAGANA LETTER A
+(assert-false (tn) (char-lower-case? #\！)) ;; U+FF01 FULLWIDTH EXCLAMATION
MARK
+(assert-false (tn) (char-lower-case? #\０)) ;; U+FF10 FULLWIDTH DIGIT ZERO
+(assert-false (tn) (char-lower-case? #\Ａ)) ;; U+FF21 FULLWIDTH LATIN
CAPITAL LETTER A
+(assert-false (tn) (char-lower-case? #\ａ)) ;; U+FF41 FULLWIDTH LATIN SMALL
LETTER A
+
+
+(total-report)
Modified: sigscheme-trunk/test/test-char.scm
==============================================================================
--- sigscheme-trunk/test/test-char.scm (original)
+++ sigscheme-trunk/test/test-char.scm Fri May 18 22:52:20 2007
@@ -1,5 +1,4 @@
-#! /usr/bin/env sscm -C EUC-JP
-;; -*- buffer-file-coding-system: euc-jp -*-
+#! /usr/bin/env sscm -C UTF-8
;; Filename : test-char.scm
;; About : unit test for R5RS char
@@ -45,6 +44,101 @@
(lambda (i)
(obj->literal (integer->char i))))
+(tn "char?")
+(assert-eq? (tn) #f (char? #f))
+(assert-eq? (tn) #f (char? #t))
+(assert-eq? (tn) #f (char? '()))
+(if (provided? "sigscheme")
+ (begin
+ (assert-eq? (tn) #f (char? (eof)))
+ (assert-eq? (tn) #f (char? (undef)))))
+(assert-eq? (tn) #f (char? 0))
+(assert-eq? (tn) #f (char? 1))
+(assert-eq? (tn) #f (char? 3))
+(assert-eq? (tn) #f (char? -1))
+(assert-eq? (tn) #f (char? -3))
+(assert-eq? (tn) #f (char? 'symbol))
+(assert-eq? (tn) #f (char? 'SYMBOL))
+(assert-eq? (tn) #t (char? #\a))
+(assert-eq? (tn) #t (char? #\ ))
+(assert-eq? (tn) #t (char? #\あ))
+(assert-eq? (tn) #f (char? ""))
+(assert-eq? (tn) #f (char? " "))
+(assert-eq? (tn) #f (char? "a"))
+(assert-eq? (tn) #f (char? "A"))
+(assert-eq? (tn) #f (char? "aBc12!"))
+(assert-eq? (tn) #f (char? "あ"))
+(assert-eq? (tn) #f (char? "あ0イう12!"))
+(assert-eq? (tn) #f (char? +))
+(assert-eq? (tn) #f (char? (lambda () #t)))
+
+(tn "char-upcase")
+(assert-equal? (tn) #\x00 (char-upcase #\x00))
+(assert-equal? (tn) #\newline (char-upcase #\newline))
+(assert-equal? (tn) #\space (char-upcase #\space))
+(assert-equal? (tn) #\x09 (char-upcase #\x09)) ;; horizontal tab (#\tab)
+(assert-equal? (tn) #\x0b (char-upcase #\x0b)) ;; vertical tab (#\vtab)
+(assert-equal? (tn) #\x0c (char-upcase #\x0c)) ;; form feed (#\page)
+(assert-equal? (tn) #\x0d (char-upcase #\x0d)) ;; carriage return
(#\return)
+(assert-equal? (tn) #\! (char-upcase #\!))
+(assert-equal? (tn) #\0 (char-upcase #\0))
+(assert-equal? (tn) #\9 (char-upcase #\9))
+(assert-equal? (tn) #\A (char-upcase #\A))
+(assert-equal? (tn) #\B (char-upcase #\B))
+(assert-equal? (tn) #\Z (char-upcase #\Z))
+(assert-equal? (tn) #\_ (char-upcase #\_))
+(assert-equal? (tn) #\A (char-upcase #\a))
+(assert-equal? (tn) #\B (char-upcase #\b))
+(assert-equal? (tn) #\Z (char-upcase #\z))
+(assert-equal? (tn) #\~ (char-upcase #\~))
+(assert-equal? (tn) #\x7f (char-upcase #\x7f))
+(tn "char-upcase non-ASCII")
+;; SigScheme currently does not support char-upcase on non-ASCII charcters
+(assert-equal? (tn) #\xa0 (char-upcase #\xa0)) ;; U+00A0 NO-BREAK SPACE
+(assert-equal? (tn) #\xff (char-upcase #\xff)) ;; U+00FF LATIN SMALL
LETTER Y WITH DIAERESIS
+(assert-equal? (tn) #\x2028 (char-upcase #\x2028)) ;; U+2028 LINE SEPARATOR
+(assert-equal? (tn) #\x2029 (char-upcase #\x2029)) ;; U+2029 PARAGRAPH
SEPARATOR
+(assert-equal? (tn) #\ (char-upcase #\ )) ;; U+3000 IDEOGRAPHIC SPACE
+(assert-equal? (tn) #\あ (char-upcase #\あ)) ;; U+3042 HIRAGANA LETTER A
+(assert-equal? (tn) #\！ (char-upcase #\！)) ;; U+FF01 FULLWIDTH
EXCLAMATION MARK
+(assert-equal? (tn) #\０ (char-upcase #\０)) ;; U+FF10 FULLWIDTH DIGIT ZERO
+(assert-equal? (tn) #\Ａ (char-upcase #\Ａ)) ;; U+FF21 FULLWIDTH LATIN
CAPITAL LETTER A
+(assert-equal? (tn) #\ａ (char-upcase #\ａ)) ;; U+FF41 FULLWIDTH LATIN
SMALL LETTER A
+
+(tn "char-downcase")
+(assert-equal? (tn) #\x00 (char-downcase #\x00))
+(assert-equal? (tn) #\newline (char-downcase #\newline))
+(assert-equal? (tn) #\space (char-downcase #\space))
+(assert-equal? (tn) #\x09 (char-downcase #\x09)) ;; horizontal tab (#\tab)
+(assert-equal? (tn) #\x0b (char-downcase #\x0b)) ;; vertical tab
(#\vtab)
+(assert-equal? (tn) #\x0c (char-downcase #\x0c)) ;; form feed
(#\page)
+(assert-equal? (tn) #\x0d (char-downcase #\x0d)) ;; carriage return
(#\return)
+(assert-equal? (tn) #\! (char-downcase #\!))
+(assert-equal? (tn) #\0 (char-downcase #\0))
+(assert-equal? (tn) #\9 (char-downcase #\9))
+(assert-equal? (tn) #\a (char-downcase #\A))
+(assert-equal? (tn) #\b (char-downcase #\B))
+(assert-equal? (tn) #\z (char-downcase #\Z))
+(assert-equal? (tn) #\_ (char-downcase #\_))
+(assert-equal? (tn) #\a (char-downcase #\a))
+(assert-equal? (tn) #\b (char-downcase #\b))
+(assert-equal? (tn) #\z (char-downcase #\z))
+(assert-equal? (tn) #\~ (char-downcase #\~))
+(assert-equal? (tn) #\x7f (char-downcase #\x7f))
+(tn "char-downcase non-ASCII")
+;; SigScheme currently does not support char-downcase on non-ASCII charcters
+(assert-equal? (tn) #\xa0 (char-downcase #\xa0)) ;; U+00A0 NO-BREAK SPACE
+(assert-equal? (tn) #\xff (char-downcase #\xff)) ;; U+00FF LATIN SMALL
LETTER Y WITH DIAERESIS
+(assert-equal? (tn) #\x2028 (char-downcase #\x2028)) ;; U+2028 LINE SEPARATOR
+(assert-equal? (tn) #\x2029 (char-downcase #\x2029)) ;; U+2029 PARAGRAPH
SEPARATOR
+(assert-equal? (tn) #\ (char-downcase #\ )) ;; U+3000 IDEOGRAPHIC SPACE
+(assert-equal? (tn) #\あ (char-downcase #\あ)) ;; U+3042 HIRAGANA LETTER A
+(assert-equal? (tn) #\！ (char-downcase #\！)) ;; U+FF01 FULLWIDTH
EXCLAMATION MARK
+(assert-equal? (tn) #\０ (char-downcase #\０)) ;; U+FF10 FULLWIDTH DIGIT
ZERO
+(assert-equal? (tn) #\Ａ (char-downcase #\Ａ)) ;; U+FF21 FULLWIDTH LATIN
CAPITAL LETTER A
+(assert-equal? (tn) #\ａ (char-downcase #\ａ)) ;; U+FF41 FULLWIDTH LATIN
SMALL LETTER A
+
+
;; invalid character literal
(tn "invalid char literal")
(assert-parse-error (tn) "#\\nonexistent")
@@ -92,19 +186,6 @@
(assert-true (tn) (char? (string-read "#\\x0a0")))
(assert-true (tn) (char? (string-read "#\\xa00")))
-;; check char?
-(assert-true "alphabet char" (char? #\a))
-(assert-true "space 1" (char? #\space))
-(assert-true "space 2" (char? #\ ))
-(assert-true "tab" (char? #\ ))
-(assert-true "newline 2" (char? #\newline))
-(assert-true "newline 2" (char? #\
-))
-(assert-true "hiragana char" (char? #\ ))
-(assert-true "( char" (char? #\())
-(assert-true ") char" (char? #\)))
-(assert-true "\\ char" (char? #\\))
-
(tn "R5RS named chars case-insensitivity")
(assert-equal? (tn) #\newline (integer->char 10))
(assert-equal? (tn) #\Newline (integer->char 10))
@@ -145,6 +226,22 @@
(assert-equal? (tn) "#\\space" (obj->literal #\x20)) ;; 32
(assert-equal? (tn) "#\\delete" (obj->literal #\x7f)) ;; 127
+(tn "R6RS named chars case-sensitivity")
+;; FIXME: SigScheme is currently not conforming to the case-sensitivity of
+;; R6RS character names. These tests must be failed in R6RS character
+;; processing.
+(assert-equal? (tn) #\NUL #\x00) ;; 0
+(assert-equal? (tn) #\ALARM #\x07) ;; 7
+(assert-equal? (tn) #\BACKSPACE #\x08) ;; 8
+(assert-equal? (tn) #\TAB #\x09) ;; 9
+(assert-equal? (tn) #\NEWLINE #\x0a) ;; 10
+(assert-equal? (tn) #\VTAB #\x0b) ;; 11
+(assert-equal? (tn) #\PAGE #\x0c) ;; 12
+(assert-equal? (tn) #\RETURN #\x0d) ;; 13
+(assert-equal? (tn) #\ESC #\x1b) ;; 27
+(assert-equal? (tn) #\SPACE #\x20) ;; 32
+(assert-equal? (tn) #\DELETE #\x7f) ;; 127
+
(tn "char literal")
(assert-equal? (tn) "#\\nul" (obj->literal #\nul)) ;; 0
(assert-equal? (tn) "#\\x01" (obj->literal #\x01)) ;; 1
@@ -796,6 +893,152 @@
(assert-equal? (tn) (integer->char 126) #\x7E) ;; 126
(assert-equal? (tn) (integer->char 127) #\x7F) ;; 127
+;; char->integer
+;; NOTE: #\x0e -style character is defined in R6RS(SRFI-75)
+(tn "char->integer")
+(assert-equal? (tn) 0 (char->integer #\nul)) ;; 0
+(assert-equal? (tn) 1 (char->integer #\x01)) ;; 1
+(assert-equal? (tn) 1 (char->integer #\x1)) ;; 1
+(assert-equal? (tn) 2 (char->integer #\x02)) ;; 2
+(assert-equal? (tn) 3 (char->integer #\x03)) ;; 3
+(assert-equal? (tn) 4 (char->integer #\x04)) ;; 4
+(assert-equal? (tn) 5 (char->integer #\x05)) ;; 5
+(assert-equal? (tn) 6 (char->integer #\x06)) ;; 6
+(assert-equal? (tn) 7 (char->integer #\alarm)) ;; 7
+(assert-equal? (tn) 8 (char->integer #\backspace)) ;; 8
+(assert-equal? (tn) 9 (char->integer #\tab)) ;; 9
+(assert-equal? (tn) 10 (char->integer #\newline)) ;; 10
+(assert-equal? (tn) 11 (char->integer #\vtab)) ;; 11
+(assert-equal? (tn) 12 (char->integer #\page)) ;; 12
+(assert-equal? (tn) 13 (char->integer #\return)) ;; 13
+(assert-equal? (tn) 14 (char->integer #\x0e)) ;; 14
+(assert-equal? (tn) 15 (char->integer #\x0f)) ;; 15
+(assert-equal? (tn) 15 (char->integer #\xf)) ;; 15
+(assert-equal? (tn) 16 (char->integer #\x10)) ;; 16
+(assert-equal? (tn) 17 (char->integer #\x11)) ;; 17
+(assert-equal? (tn) 18 (char->integer #\x12)) ;; 18
+(assert-equal? (tn) 19 (char->integer #\x13)) ;; 19
+(assert-equal? (tn) 20 (char->integer #\x14)) ;; 20
+(assert-equal? (tn) 21 (char->integer #\x15)) ;; 21
+(assert-equal? (tn) 22 (char->integer #\x16)) ;; 22
+(assert-equal? (tn) 23 (char->integer #\x17)) ;; 23
+(assert-equal? (tn) 24 (char->integer #\x18)) ;; 24
+(assert-equal? (tn) 25 (char->integer #\x19)) ;; 25
+(assert-equal? (tn) 26 (char->integer #\x1a)) ;; 26
+(assert-equal? (tn) 27 (char->integer #\esc)) ;; 27
+(assert-equal? (tn) 28 (char->integer #\x1c)) ;; 28
+(assert-equal? (tn) 29 (char->integer #\x1d)) ;; 29
+(assert-equal? (tn) 30 (char->integer #\x1e)) ;; 30
+(assert-equal? (tn) 31 (char->integer #\x1f)) ;; 31
+(assert-equal? (tn) 31 (char->integer #\x01f)) ;; 31
+(assert-equal? (tn) 32 (char->integer #\space)) ;; 32
+(assert-equal? (tn) 33 (char->integer #\!)) ;; 33
+(assert-equal? (tn) 34 (char->integer #\")) ;; 34
+(assert-equal? (tn) 35 (char->integer #\#)) ;; 35
+(assert-equal? (tn) 36 (char->integer #\$)) ;; 36
+(assert-equal? (tn) 37 (char->integer #\%)) ;; 37
+(assert-equal? (tn) 38 (char->integer #\&)) ;; 38
+(assert-equal? (tn) 39 (char->integer #\')) ;; 39
+(assert-equal? (tn) 40 (char->integer #\()) ;; 40
+(assert-equal? (tn) 41 (char->integer #\))) ;; 41
+(assert-equal? (tn) 42 (char->integer #\*)) ;; 42
+(assert-equal? (tn) 43 (char->integer #\+)) ;; 43
+(assert-equal? (tn) 44 (char->integer #\,)) ;; 44
+(assert-equal? (tn) 45 (char->integer #\-)) ;; 45
+(assert-equal? (tn) 46 (char->integer #\.)) ;; 46
+(assert-equal? (tn) 47 (char->integer #\/)) ;; 47
+(assert-equal? (tn) 48 (char->integer #\0)) ;; 48
+(assert-equal? (tn) 49 (char->integer #\1)) ;; 49
+(assert-equal? (tn) 50 (char->integer #\2)) ;; 50
+(assert-equal? (tn) 51 (char->integer #\3)) ;; 51
+(assert-equal? (tn) 52 (char->integer #\4)) ;; 52
+(assert-equal? (tn) 53 (char->integer #\5)) ;; 53
+(assert-equal? (tn) 54 (char->integer #\6)) ;; 54
+(assert-equal? (tn) 55 (char->integer #\7)) ;; 55
+(assert-equal? (tn) 56 (char->integer #\8)) ;; 56
+(assert-equal? (tn) 57 (char->integer #\9)) ;; 57
+(assert-equal? (tn) 58 (char->integer #\:)) ;; 58
+(assert-equal? (tn) 59 (char->integer #\;)) ;; 59
+(assert-equal? (tn) 60 (char->integer #\<)) ;; 60
+(assert-equal? (tn) 61 (char->integer #\=)) ;; 61
+(assert-equal? (tn) 62 (char->integer #\>)) ;; 62
+(assert-equal? (tn) 63 (char->integer #\?)) ;; 63
+(assert-equal? (tn) 64 (char->integer #\@)) ;; 64
+(assert-equal? (tn) 65 (char->integer #\A)) ;; 65
+(assert-equal? (tn) 66 (char->integer #\B)) ;; 66
+(assert-equal? (tn) 67 (char->integer #\C)) ;; 67
+(assert-equal? (tn) 68 (char->integer #\D)) ;; 68
+(assert-equal? (tn) 69 (char->integer #\E)) ;; 69
+(assert-equal? (tn) 70 (char->integer #\F)) ;; 70
+(assert-equal? (tn) 71 (char->integer #\G)) ;; 71
+(assert-equal? (tn) 72 (char->integer #\H)) ;; 72
+(assert-equal? (tn) 73 (char->integer #\I)) ;; 73
+(assert-equal? (tn) 74 (char->integer #\J)) ;; 74
+(assert-equal? (tn) 75 (char->integer #\K)) ;; 75
+(assert-equal? (tn) 76 (char->integer #\L)) ;; 76
+(assert-equal? (tn) 77 (char->integer #\M)) ;; 77
+(assert-equal? (tn) 78 (char->integer #\N)) ;; 78
+(assert-equal? (tn) 79 (char->integer #\O)) ;; 79
+(assert-equal? (tn) 80 (char->integer #\P)) ;; 80
+(assert-equal? (tn) 81 (char->integer #\Q)) ;; 81
+(assert-equal? (tn) 82 (char->integer #\R)) ;; 82
+(assert-equal? (tn) 83 (char->integer #\S)) ;; 83
+(assert-equal? (tn) 84 (char->integer #\T)) ;; 84
+(assert-equal? (tn) 85 (char->integer #\U)) ;; 85
+(assert-equal? (tn) 86 (char->integer #\V)) ;; 86
+(assert-equal? (tn) 87 (char->integer #\W)) ;; 87
+(assert-equal? (tn) 88 (char->integer #\X)) ;; 88
+(assert-equal? (tn) 89 (char->integer #\Y)) ;; 89
+(assert-equal? (tn) 90 (char->integer #\Z)) ;; 90
+(assert-equal? (tn) 91 (char->integer #\[)) ;; 91
+(assert-equal? (tn) 92 (char->integer #\\)) ;; 92
+(assert-equal? (tn) 93 (char->integer #\])) ;; 93
+(assert-equal? (tn) 94 (char->integer #\^)) ;; 94
+(assert-equal? (tn) 95 (char->integer #\_)) ;; 95
+(assert-equal? (tn) 96 (char->integer #\`)) ;; 96
+(assert-equal? (tn) 97 (char->integer #\a)) ;; 97
+(assert-equal? (tn) 98 (char->integer #\b)) ;; 98
+(assert-equal? (tn) 99 (char->integer #\c)) ;; 99
+(assert-equal? (tn) 100 (char->integer #\d)) ;; 100
+(assert-equal? (tn) 101 (char->integer #\e)) ;; 101
+(assert-equal? (tn) 102 (char->integer #\f)) ;; 102
+(assert-equal? (tn) 103 (char->integer #\g)) ;; 103
+(assert-equal? (tn) 104 (char->integer #\h)) ;; 104
+(assert-equal? (tn) 105 (char->integer #\i)) ;; 105
+(assert-equal? (tn) 106 (char->integer #\j)) ;; 106
+(assert-equal? (tn) 107 (char->integer #\k)) ;; 107
+(assert-equal? (tn) 108 (char->integer #\l)) ;; 108
+(assert-equal? (tn) 109 (char->integer #\m)) ;; 109
+(assert-equal? (tn) 110 (char->integer #\n)) ;; 110
+(assert-equal? (tn) 111 (char->integer #\o)) ;; 111
+(assert-equal? (tn) 112 (char->integer #\p)) ;; 112
+(assert-equal? (tn) 113 (char->integer #\q)) ;; 113
+(assert-equal? (tn) 114 (char->integer #\r)) ;; 114
+(assert-equal? (tn) 115 (char->integer #\s)) ;; 115
+(assert-equal? (tn) 116 (char->integer #\t)) ;; 116
+(assert-equal? (tn) 117 (char->integer #\u)) ;; 117
+(assert-equal? (tn) 118 (char->integer #\v)) ;; 118
+(assert-equal? (tn) 119 (char->integer #\w)) ;; 119
+(assert-equal? (tn) 120 (char->integer #\x)) ;; 120
+(assert-equal? (tn) 121 (char->integer #\y)) ;; 121
+(assert-equal? (tn) 122 (char->integer #\z)) ;; 122
+(assert-equal? (tn) 123 (char->integer #\{)) ;; 123
+(assert-equal? (tn) 124 (char->integer #\|)) ;; 124
+(assert-equal? (tn) 125 (char->integer #\})) ;; 125
+(assert-equal? (tn) 126 (char->integer #\~)) ;; 126
+(assert-equal? (tn) 127 (char->integer #\delete)) ;; 127
+(tn "char->integer non-ASCII")
+(assert-equal? (tn) #xa0 (char->integer #\xa0)) ;; NO-BREAK SPACE
+(assert-equal? (tn) #xff (char->integer #\xff)) ;; LATIN SMALL LETTER Y
WITH DIAERESIS
+(assert-equal? (tn) #x2028 (char->integer #\x2028)) ;; LINE SEPARATOR
+(assert-equal? (tn) #x2029 (char->integer #\x2029)) ;; PARAGRAPH SEPARATOR
+(assert-equal? (tn) #x3000 (char->integer #\ )) ;; IDEOGRAPHIC SPACE
+(assert-equal? (tn) #x3042 (char->integer #\あ)) ;; HIRAGANA LETTER A
+(assert-equal? (tn) #xff01 (char->integer #\！)) ;; FULLWIDTH EXCLAMATION
MARK
+(assert-equal? (tn) #xff10 (char->integer #\０)) ;; FULLWIDTH DIGIT ZERO
+(assert-equal? (tn) #xff21 (char->integer #\Ａ)) ;; FULLWIDTH LATIN CAPITAL
LETTER A
+(assert-equal? (tn) #xff41 (char->integer #\ａ)) ;; FULLWIDTH LATIN SMALL
LETTER A
+
;; integer->char
;; NOTE: #\x0e -style character is defined in R6RS(SRFI-75)
(tn "integer->char")
@@ -930,6 +1173,26 @@
(assert-equal? (tn) #\} (integer->char 125)) ;; 125
(assert-equal? (tn) #\~ (integer->char 126)) ;; 126
(assert-equal? (tn) #\delete (integer->char 127)) ;; 127
+(tn "integer->char non-ASCII")
+(assert-equal? (tn) #\xa0 (integer->char #xa0)) ;; NO-BREAK SPACE
+(assert-equal? (tn) #\xff (integer->char #xff)) ;; LATIN SMALL LETTER Y
WITH DIAERESIS
+(assert-equal? (tn) #\x2028 (integer->char #x2028)) ;; LINE SEPARATOR
+(assert-equal? (tn) #\x2029 (integer->char #x2029)) ;; PARAGRAPH SEPARATOR
+(assert-equal? (tn) #\ (integer->char #x3000)) ;; IDEOGRAPHIC SPACE
+(assert-equal? (tn) #\あ (integer->char #x3042)) ;; HIRAGANA LETTER A
+(assert-equal? (tn) #\！ (integer->char #xff01)) ;; FULLWIDTH EXCLAMATION
MARK
+(assert-equal? (tn) #\０ (integer->char #xff10)) ;; FULLWIDTH DIGIT ZERO
+(assert-equal? (tn) #\Ａ (integer->char #xff21)) ;; FULLWIDTH LATIN CAPITAL
LETTER A
+(assert-equal? (tn) #\ａ (integer->char #xff41)) ;; FULLWIDTH LATIN SMALL
LETTER A
+(tn "integer->char invalid Unicode charcters")
+(assert-error (tn) (lambda () (integer->char -1)))
+(assert-true (tn) (char? (integer->char 0))) ;; valid
+(assert-true (tn) (char? (integer->char #xd7ff))) ;; valid
+(assert-error (tn) (lambda () (integer->char #xd800)))
+(assert-error (tn) (lambda () (integer->char #xdfff)))
+(assert-true (tn) (char? (integer->char #xe000))) ;; valid
+(assert-true (tn) (char? (integer->char #x10ffff))) ;; valid
+(assert-error (tn) (lambda () (integer->char #x110000)))
(tn "integer->char (string form)")
(assert-equal? (tn) "#\\nul" (i->chlit 0)) ;; 0
@@ -1060,5 +1323,13 @@
(assert-equal? (tn) "#\\}" (i->chlit 125)) ;; 125
(assert-equal? (tn) "#\\~" (i->chlit 126)) ;; 126
(assert-equal? (tn) "#\\delete" (i->chlit 127)) ;; 127
+(tn "integer->char non-ASCII (string form)")
+(assert-equal? (tn) "#\\ " (i->chlit #xff)) ;; LATIN SMALL LETTER Y
WITH DIAERESIS
+(assert-equal? (tn) "#\\ " (i->chlit #x3000)) ;; IDEOGRAPHIC SPACE
+(assert-equal? (tn) "#\\あ" (i->chlit #x3042)) ;; HIRAGANA LETTER A
+(assert-equal? (tn) "#\\！" (i->chlit #xff01)) ;; FULLWIDTH EXCLAMATION
MARK
+(assert-equal? (tn) "#\\０" (i->chlit #xff10)) ;; FULLWIDTH DIGIT ZERO
+(assert-equal? (tn) "#\\Ａ" (i->chlit #xff21)) ;; FULLWIDTH LATIN
CAPITAL LETTER A
+(assert-equal? (tn) "#\\ａ" (i->chlit #xff41)) ;; FULLWIDTH LATIN SMALL
LETTER A
(total-report)
