guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, string-abstraction, updated. 6e50a7ce4


From: Michael Gran
Subject: [Guile-commits] GNU Guile branch, string-abstraction, updated. 6e50a7ce45d84ecc34b9fc796c5692c360698bf9
Date: Sun, 03 May 2009 13:43:15 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=6e50a7ce45d84ecc34b9fc796c5692c360698bf9

The branch, string-abstraction has been updated
       via  6e50a7ce45d84ecc34b9fc796c5692c360698bf9 (commit)
       via  93c625991899e33f99f02308aea8f1fa92996649 (commit)
       via  f49070259e92a56d57047f312a731469d54e696f (commit)
       via  552c1935f6719e88c04f609448a6ee991bf0f559 (commit)
       via  b298407b07f538f6ea99d5fd130c85cd1744dde7 (commit)
       via  edafebac554663f510bcfd04cce0f92ebc869b5c (commit)
       via  39831ed9afccadc48f4076996490a0be67c66238 (commit)
       via  73b9601ab48e0cb54c53662e33d474c3a85aa818 (commit)
       via  cfcf27eaacc15b1d72f419d78360bb79ec45f7cc (commit)
       via  4ff021196965a01774437b1f5c2cb790707d55cb (commit)
      from  feda5bd1c08d69628ec9fdb5577d5c894b70b6e8 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 6e50a7ce45d84ecc34b9fc796c5692c360698bf9
Author: Michael Gran <address@hidden>
Date:   Sun May 3 06:38:41 2009 -0700

    Add separate files for R6RS char/string tests
    
        * test-suite/tests/chars-r6rs.test
        * test-suite/test/strings-r6rs.test

commit 93c625991899e33f99f02308aea8f1fa92996649
Author: Michael Gran <address@hidden>
Date:   Sat May 2 14:20:35 2009 -0700

    More changes to revert reader behavior to be more 1.8.x-like
    by default
    
        * libguile/strings.c: fix regression on behavior of backslashes
        in weird symbols
        * libguile/symbols.c: simplify logic to detect keywordish symbols
        * test-suite/tests/chars.test
        * test-suite/tests/reader.test
        * test-suite/tests/strings.test: test 1.8.x behavior by default

commit f49070259e92a56d57047f312a731469d54e696f
Author: Michael Gran <address@hidden>
Date:   Sat May 2 14:16:40 2009 -0700

    Add missing macros for scheme character classification
    
        * libguile/read.h

commit 552c1935f6719e88c04f609448a6ee991bf0f559
Author: Michael Gran <address@hidden>
Date:   Sat May 2 14:14:05 2009 -0700

    Fix regression on basename
    
        * libguile/filesys.c

commit b298407b07f538f6ea99d5fd130c85cd1744dde7
Author: Michael Gran <address@hidden>
Date:   Sat May 2 14:12:40 2009 -0700

    Use new func scm_char_eq for SCM_CHAR_EQ.
    
        * libguile/chars.h

commit edafebac554663f510bcfd04cce0f92ebc869b5c
Author: Michael Gran <address@hidden>
Date:   Sat May 2 14:07:26 2009 -0700

    Avoid error about assignment to lvaue when SCM_DEBUG is defined
    
        * libguile/programs.[ch]

commit 39831ed9afccadc48f4076996490a0be67c66238
Author: Michael Gran <address@hidden>
Date:   Sat May 2 13:16:41 2009 -0700

    Encase R6RS and hex escapes as a reader option
    
        * libguile/chars.c:
        * libguile/print.c:
        * libguile/private-options.h

commit 73b9601ab48e0cb54c53662e33d474c3a85aa818
Author: Michael Gran <address@hidden>
Date:   Sat May 2 13:11:29 2009 -0700

    Use scm_[un]read_char for all character input.
    
        * read.c: Use the convention that scm_read_char and
        scm_unread_char are intended for characters that have the
        'internal' encoding while scm_getc is for C ASCII characters.
        This will allow for the future use of scm_read_char as dealing
        with encodings.

commit cfcf27eaacc15b1d72f419d78360bb79ec45f7cc
Merge: feda5bd1c08d69628ec9fdb5577d5c894b70b6e8 
4ff021196965a01774437b1f5c2cb790707d55cb
Author: Michael Gran <address@hidden>
Date:   Sun Apr 26 09:38:48 2009 -0700

    Merge branch 'master' into string-abstraction
    
    Conflicts:
        libguile/read.c

commit 4ff021196965a01774437b1f5c2cb790707d55cb
Author: Michael Gran <address@hidden>
Date:   Fri Apr 24 22:23:13 2009 -0700

    Symbols longer than 128 chars can cause an exception.  Also, the 
terminating colon of long postfix keywords are not handled correctly.
    
        * test-suite/tests/reader.test ("read-options"): Add test
        for long postfix keywords.
    
        * libguile/read.c (scm_read_mixed_case_symbol): Fix
        exception on symbols are greater than 128 chars.  Also,
        colons are not stripped from long postfix keywords.

-----------------------------------------------------------------------

Summary of changes:
 libguile/chars.c                   |  103 +++--
 libguile/chars.h                   |    6 +-
 libguile/filesys.c                 |    2 +-
 libguile/print.c                   |   34 +-
 libguile/private-options.h         |   10 +-
 libguile/programs.c                |    2 +-
 libguile/programs.h                |    1 +
 libguile/read.c                    |  876 +++++++++++++++++-------------------
 libguile/read.h                    |    6 +
 libguile/strings.c                 |   10 +
 libguile/symbols.c                 |    8 +-
 test-suite/tests/chars-r6rs.test   |  226 ++++++++++
 test-suite/tests/chars.test        |  279 ++----------
 test-suite/tests/reader.test       |    9 +-
 test-suite/tests/strings-r6rs.test |  203 +++++++++
 test-suite/tests/strings.test      |  173 +-------
 16 files changed, 1018 insertions(+), 930 deletions(-)
 create mode 100644 test-suite/tests/chars-r6rs.test
 create mode 100644 test-suite/tests/strings-r6rs.test

diff --git a/libguile/chars.c b/libguile/chars.c
index f8ac8ac..cc916c2 100644
--- a/libguile/chars.c
+++ b/libguile/chars.c
@@ -28,11 +28,25 @@
 
 #include "libguile/chars.h"
 #include "libguile/srfi-14.h"
+#include "libguile/private-options.h"
 
 #include "unicase.h"
 #include "unictype.h"
 
 
+int
+scm_char_eq (SCM sch, char cch)
+{
+  scm_t_uint32 uch;
+
+  if (SCM_EOF_OBJECT_P (sch))
+    return 0;
+  uch = SCM_CHAR(sch);
+  if (uch > 255)
+    return 0;
+  return ((unsigned char)cch == (unsigned char)(uch));
+}
+
 char
 scm_i_char_to_int8 (SCM c)
 {
@@ -52,6 +66,15 @@ scm_i_char_to_uint32 (SCM c)
   return SCM_ITAG8_DATA(c);
 }
 
+scm_t_uint32
+scm_i_char_to_uint32_or_eof (SCM c)
+{
+  if (SCM_EOF_OBJECT_P (c))
+    return (scm_t_uint32) EOF;
+  else
+    return SCM_ITAG8_DATA(c);
+}
+
 SCM scm_i_char_from_int8 (char c)
 {
   return SCM_MAKE_ITAG8((scm_t_bits) (scm_t_uint32) (unsigned char) c, 
@@ -336,7 +359,6 @@ scm_c_upcase (scm_t_uint32 c)
     return c;
 }
 
-
 scm_t_uint32
 scm_c_downcase (scm_t_uint32 c)
 {
@@ -379,15 +401,29 @@ const scm_t_uint32 const scm_r5rs_charnums[] =
 const int scm_n_r5rs_charnames = sizeof (scm_r5rs_charnames) / sizeof (char *);
 
 /* The abbreviated names for control characters.  */
-const char *const scm_control_charnames[] = 
+const char *const scm_C0_control_charnames[] = 
   {
     /* C0 controls */
     "nul", "soh", "stx", "etx", "eot", "enq", "ack", "bel",
     "bs",  "ht",  "lf",  "vt",  "ff",  "cr",  "so",  "si",
     "dle", "dc1", "dc2", "dc3", "dc4", "nak", "syn", "etb", 
     "can", "em",  "sub", "esc", "fs",  "gs",  "rs",  "us",
-    "sp", "del",
-    /* C1 controls */
+    "sp", "del"
+  };
+
+const scm_t_uint32 const scm_C0_control_charnums[] = 
+  {
+    0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,
+    0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f,
+    0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17,
+    0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f,
+    0x20, 0x7f
+  };
+
+int scm_n_C0_control_charnames = sizeof (scm_C0_control_charnames) / sizeof 
(char *);
+
+const char *const scm_C1_control_charnames[] = 
+  {
     "bph", "nbh", "ind", "nel", "ssa", "esa", 
     "hts", "htj", "vts", "pld", "plu", "ri" , "ss2", "ss3",
     "dcs", "pu1", "pu2", "sts", "cch", "mw" , "spa", "epa",
@@ -395,15 +431,8 @@ const char *const scm_control_charnames[] =
     "nbsp", "shy"
   };
 
-const scm_t_uint32 const scm_control_charnums[] = 
+const scm_t_uint32 const scm_C1_control_charnums[] = 
   {
-    /* C0 controls */
-    0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,
-    0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f,
-    0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17,
-    0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f,
-    0x20, 0x7f,
-    /* C1 controls */
     0x82, 0x83, 0x84, 0x85, 0x86, 0x87,
     0x88, 0x89, 0x8a, 0x8b, 0x8c, 0x8d, 0x8e, 0x8f,
     0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97,
@@ -411,17 +440,18 @@ const scm_t_uint32 const scm_control_charnums[] =
     0xa0, 0xad
   };
 
-int scm_n_control_charnames = sizeof (scm_control_charnames) / sizeof (char *);
+int scm_n_C1_control_charnames = sizeof (scm_C1_control_charnames) / sizeof 
(char *);
 
-/* Lastly, there are some old names kept for compatibility.  */
+/* Lastly, there are some old names kept for compatibility or that
+   have higher priority under R6RS than Guile 1.8.x.  */
 const char *const scm_alt_charnames[] = 
   {
-    "null", "nl", "np"
+    "null", "backspace", "tab", "nl", "newline", "np", "page", "return",
   };
   
 const scm_t_uint32 const scm_alt_charnums[] = 
   {
-    0x00, 0x0a, 0x0c
+    0x00, 0x08, 0x09, 0x0a, 0x0a, 0x0c, 0x0c, 0x0d
   };
 
 int scm_n_alt_charnames = sizeof (scm_alt_charnames) / sizeof (char *);
@@ -434,17 +464,23 @@ scm_i_charname (SCM chr)
   int c;
   scm_t_uint32 i = SCM_CHAR (chr);
 
-  for (c = 0; c < scm_n_r6rs_charnames; c++)
-    if (scm_r6rs_charnums[c] == i)
-      return scm_r6rs_charnames[c];
+  if (SCM_R6RS_ESCAPES_P)
+    for (c = 0; c < scm_n_r6rs_charnames; c++)
+      if (scm_r6rs_charnums[c] == i)
+       return scm_r6rs_charnames[c];
 
   for (c = 0; c < scm_n_r5rs_charnames; c++)
     if (scm_r5rs_charnums[c] == i)
       return scm_r5rs_charnames[c];
 
-  for (c = 0; c < scm_n_control_charnames; c++)
-    if (scm_control_charnums[c] == i)
-      return scm_control_charnames[c];
+  for (c = 0; c < scm_n_C0_control_charnames; c++)
+    if (scm_C0_control_charnums[c] == i)
+      return scm_C0_control_charnames[c];
+
+  if (SCM_R6RS_ESCAPES_P)
+    for (c = 0; c < scm_n_C1_control_charnames; c++)
+      if (scm_C1_control_charnums[c] == i)
+       return scm_C1_control_charnames[c];
 
   for (c = 0; c < scm_n_alt_charnames; c++)
     if (scm_alt_charnums[c] == i)
@@ -461,10 +497,11 @@ scm_i_charname_to_char (const char *charname, size_t 
charname_len)
 
   /* First, start with R6RS charnames.  According to R6RS,
      these are supposed to be case sensitive.  */
-  for (c = 0; c < scm_n_r6rs_charnames; c++)
-    if ((strlen (scm_r6rs_charnames[c]) == charname_len)
-       && (!strncmp (scm_r6rs_charnames[c], charname, charname_len)))
-      return SCM_MAKE_CHAR (scm_r6rs_charnums[c]);
+  if (SCM_R6RS_ESCAPES_P)
+    for (c = 0; c < scm_n_r6rs_charnames; c++)
+      if ((strlen (scm_r6rs_charnames[c]) == charname_len)
+         && (!strncmp (scm_r6rs_charnames[c], charname, charname_len)))
+       return SCM_MAKE_CHAR (scm_r6rs_charnums[c]);
 
   /* Then the R5RS charnames.  These are supposed to be case
      insensitive. */
@@ -474,10 +511,16 @@ scm_i_charname_to_char (const char *charname, size_t 
charname_len)
       return SCM_MAKE_CHAR (scm_r5rs_charnums[c]);
 
   /* Then come the controls.  These are not case sensitive.  */
-  for (c = 0; c < scm_n_control_charnames; c++)
-    if ((strlen (scm_control_charnames[c]) == charname_len)
-       && (!strncasecmp (scm_control_charnames[c], charname, charname_len)))
-      return SCM_MAKE_CHAR (scm_control_charnums[c]);
+  for (c = 0; c < scm_n_C0_control_charnames; c++)
+    if ((strlen (scm_C0_control_charnames[c]) == charname_len)
+       && (!strncasecmp (scm_C0_control_charnames[c], charname, charname_len)))
+      return SCM_MAKE_CHAR (scm_C0_control_charnums[c]);
+
+  if (SCM_R6RS_ESCAPES_P)
+    for (c = 0; c < scm_n_C1_control_charnames; c++)
+      if ((strlen (scm_C1_control_charnames[c]) == charname_len)
+         && (!strncasecmp (scm_C1_control_charnames[c], charname, 
charname_len)))
+       return SCM_MAKE_CHAR (scm_C1_control_charnums[c]);
 
   /* Lastly are some old names carried over for compatibility.  */
   for (c = 0; c < scm_n_alt_charnames; c++)
diff --git a/libguile/chars.h b/libguile/chars.h
index 249c1e1..b3a7aef 100644
--- a/libguile/chars.h
+++ b/libguile/chars.h
@@ -41,10 +41,14 @@
 #define SCM_MAKE_8BIT_CHAR(x) (scm_i_char_from_int8(x))
 
 #define SCM_UCS4(x) ((scm_t_uint32) (unsigned char) (x))
-
 
+#define SCM_CHAR_EQ(c,x) (scm_char_eq(c,x))
+
+
+SCM_INTERNAL int scm_char_eq (SCM sch, char cch);
 SCM_INTERNAL char scm_i_char_to_int8 (SCM c);
 SCM_INTERNAL scm_t_uint32 scm_i_char_to_uint32 (SCM c);
+SCM_INTERNAL scm_t_uint32 scm_i_char_to_uint32_or_eof (SCM c);
 SCM_INTERNAL SCM scm_i_char_from_int8 (char c);
 SCM_INTERNAL SCM scm_i_char_from_uint32 (scm_t_uint32 c);
 SCM_API SCM scm_char_p (SCM x);
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 8249c28..d2c71d8 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1640,7 +1640,7 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
     end = i;
 #ifdef __MINGW32__
   while (i >= 0 && (!scm_i_string_ref_eq_char (filename, i, '/')
-                   || !scm_i_string_ref_eq_char (filename, i, '\\')))
+                   && !scm_i_string_ref_eq_char (filename, i, '\\')))
     --i;
 #else
   while (i >= 0 && !scm_i_string_ref_eq_char (filename, i, '/'))
diff --git a/libguile/print.c b/libguile/print.c
index da03523..65ba5e8 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -46,7 +46,6 @@
 
 #include "libguile/validate.h"
 #include "libguile/print.h"
-
 #include "libguile/private-options.h"
 
 
@@ -478,27 +477,32 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
                scm_puts (name, port);
              else if (i >= 0x80)
                {
-                 scm_putc ('x', port);
-                 scm_intprint (i, 16, port);
+                 if (SCM_R6RS_ESCAPES_P)
+                   {
+                     scm_putc ('x', port);
+                     scm_intprint (i, 16, port);
+                   }
+                 else
+                   scm_intprint (i, 8, port);
                }
              else
                scm_putc (i, port);
            }
          else
            {
-             if (i < 0x80)
+             //if (i < 0x80)
                scm_putc (i, port);
-             else
-               {
-                 /* FIXME: need port encoding.  */
-                 SCM s = scm_string (scm_list_1 (SCM_MAKE_CHAR (i)));
-                 char *str;
-                 size_t len;
-
-                 str = scm_to_locale_stringn (s, &len);
-                 scm_lfwrite (str, len, port);
-                 free (str);
-               }
+             /* else */
+/*             { */
+/*               /\* FIXME: need port encoding.  *\/ */
+/*               SCM s = scm_string (scm_list_1 (SCM_MAKE_CHAR (i))); */
+/*               char *str; */
+/*               size_t len; */
+
+/*               str = scm_to_locale_stringn (s, &len); */
+/*               scm_lfwrite (str, len, port); */
+/*               free (str); */
+/*             } */
              scm_remember_upto_here_1 (exp);
            }
        }
diff --git a/libguile/private-options.h b/libguile/private-options.h
index eeaf0c1..bdf2bb6 100644
--- a/libguile/private-options.h
+++ b/libguile/private-options.h
@@ -93,11 +93,13 @@ SCM_API scm_t_option scm_read_opts[];
 #define SCM_CASE_INSENSITIVE_P scm_read_opts[2].val
 #define SCM_KEYWORD_STYLE      scm_read_opts[3].val
 #if SCM_ENABLE_ELISP
-#define SCM_ELISP_VECTORS_P    scm_read_opts[4].val
-#define SCM_ESCAPED_PARENS_P   scm_read_opts[5].val
-#define SCM_N_READ_OPTIONS 6
+# define SCM_ELISP_VECTORS_P    scm_read_opts[4].val
+# define SCM_ESCAPED_PARENS_P   scm_read_opts[5].val
+# define SCM_R6RS_ESCAPES_P     scm_read_opts[6].val
+# define SCM_N_READ_OPTIONS 7
 #else
-#define SCM_N_READ_OPTIONS 4
+# define SCM_R6RS_ESCAPES_P     scm_read_opts[4].val
+# define SCM_N_READ_OPTIONS 5
 #endif
 
 #endif  /* PRIVATE_OPTIONS */ 
diff --git a/libguile/programs.c b/libguile/programs.c
index 8e89829..cb5cbba 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -340,7 +340,7 @@ SCM_DEFINE (scm_program_external_set_x, 
"program-external-set!", 2, 0, 0,
 {
   SCM_VALIDATE_PROGRAM (1, program);
   SCM_VALIDATE_LIST (2, external);
-  SCM_PROGRAM_EXTERNALS (program) = external;
+  SCM_SET_PROGRAM_EXTERNALS (program,external);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
diff --git a/libguile/programs.h b/libguile/programs.h
index 68a6936..6255cb9 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -59,6 +59,7 @@ extern scm_t_bits scm_tc16_program;
 #define SCM_PROGRAM_OBJCODE(x) (SCM_SMOB_OBJECT (x))
 #define SCM_PROGRAM_OBJTABLE(x)        (SCM_SMOB_OBJECT_2 (x))
 #define SCM_PROGRAM_EXTERNALS(x) (SCM_SMOB_OBJECT_3 (x))
+#define SCM_SET_PROGRAM_EXTERNALS(x,obj) (SCM_SET_SMOB_OBJECT_3 (x,obj))
 #define SCM_PROGRAM_DATA(x)    (SCM_OBJCODE_DATA (SCM_PROGRAM_OBJCODE (x)))
 #define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P)
 #define SCM_PROGRAM_IS_BOOT(x) (SCM_SMOB_FLAGS (x) & SCM_F_PROGRAM_IS_BOOT)
diff --git a/libguile/read.c b/libguile/read.c
index 06a1555..f027123 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -70,6 +70,8 @@ scm_t_option scm_read_opts[] = {
   { SCM_OPTION_BOOLEAN, "elisp-strings", 0,
     "Support `\\(' and `\\)' in strings."},
 #endif
+  { SCM_OPTION_BOOLEAN, "r6rs-escapes", 0,
+    "Support new R6RS character names and character escapes"},
   { 0, },
 };
 
@@ -147,178 +149,173 @@ static SCM *scm_read_hash_procedures;
 /* The maximum size of Scheme character names.  */
 #define READER_CHAR_NAME_MAX_SIZE      50
 
-
-/* `isblank' is only in C99.  */
-#define CHAR_IS_BLANK_(_chr)                                   \
-  (((_chr) == ' ') || ((_chr) == '\t') || ((_chr) == '\n')     \
-   || ((_chr) == '\f') || ((_chr) == '\r'))
+#define SCHAR_IS_BLANK_(_chr)                                  \
+  (SCM_CHAR_EQ(_chr, ' ')                                              \
+   || SCM_CHAR_EQ(_chr, '\t')                                  \
+   || SCM_CHAR_EQ(_chr, '\n')                                  \
+   || SCM_CHAR_EQ(_chr, '\f')                                  \
+   || SCM_CHAR_EQ(_chr, '\r'))
 
 #ifdef MSDOS
-# define CHAR_IS_BLANK(_chr)                   \
-  ((CHAR_IS_BLANK_ (chr)) || ((_chr) == 26))
+# define SCHAR_IS_BLANK(_chr)                                  \
+  ((SCHAR_IS_BLANK_ (chr))                                     \
+   || SCM_CHAR_EQ(_chr, 26))
 #else
-# define CHAR_IS_BLANK CHAR_IS_BLANK_
+# define SCHAR_IS_BLANK SCHAR_IS_BLANK_
 #endif
 
 
+
 /* R5RS one-character delimiters (see section 7.1.1, ``Lexical
    structure'').  */
-#define CHAR_IS_R5RS_DELIMITER(c)                              \
-  (CHAR_IS_BLANK (c)                                           \
-   || (c == ')') || (c == '(') || (c == ';') || (c == '"'))
-
-#define CHAR_IS_DELIMITER  CHAR_IS_R5RS_DELIMITER
-
-/* Exponent markers, as defined in section 7.1.1 of R5RS, ``Lexical
-   Structure''.  */
-#define CHAR_IS_EXPONENT_MARKER(_chr)                          \
-  (((_chr) == 'e') || ((_chr) == 's') || ((_chr) == 'f')       \
-   || ((_chr) == 'd') || ((_chr) == 'l'))
-
-/* An inlinable version of `scm_c_downcase ()'.  */
-#define CHAR_DOWNCASE(_chr)                            \
-  (((_chr) <= UCHAR_MAX) ? tolower (_chr) : (_chr))
+#define SCHAR_IS_R5RS_DELIMITER(c)                             \
+  (SCHAR_IS_BLANK (c)                                          \
+   || SCM_CHAR_EQ(c,')')                                       \
+   || SCM_CHAR_EQ(c,'(')                                       \
+   || SCM_CHAR_EQ(c,';')                                       \
+   || SCM_CHAR_EQ(c,'"'))                                              
 
+#define SCHAR_IS_DELIMITER  SCHAR_IS_R5RS_DELIMITER
 
 /* Read an SCSH block comment.  */
-static inline SCM scm_read_scsh_block_comment (int chr, SCM port);
+static inline SCM scm_read_scsh_block_comment (SCM chr, SCM port);
 
 /* Read from PORT until a delimiter (e.g., a whitespace) is read.  Return
    zero if the whole token fits in BUF, non-zero otherwise.  */
 static inline int
-read_token (SCM port, scm_t_uint32 *buf, size_t buf_size, size_t *read)
+read_token (SCM port, SCM buf, size_t *read)
 {
+  SCM chr;
   *read = 0;
 
-  while (*read < buf_size)
+  while (*read < scm_i_string_length (buf))
     {
-      scm_t_uint32 chr;
-
-      chr = scm_getc (port);
-      chr = (SCM_CASE_INSENSITIVE_P ? CHAR_DOWNCASE (chr) : chr);
+      chr = scm_read_char (port);
 
-      if (chr == (scm_t_uint32) EOF)
+      if (SCM_EOF_OBJECT_P (chr))
        return 0;
-      else if (CHAR_IS_DELIMITER (chr))
+
+      chr = (SCM_CASE_INSENSITIVE_P ? scm_char_downcase (chr) : chr);
+
+      if (SCHAR_IS_DELIMITER (chr))
        {
-         scm_ungetc (chr, port);
+         scm_unread_char (chr, port);
          return 0;
        }
-      else
-       {
-         *buf = chr;
-         buf++, (*read)++;
-       }
+
+      scm_i_string_set (buf, *read, chr);
+      (*read)++;
     }
 
   return 1;
 }
 
-static inline int
-read_token2 (SCM port, char *buf, size_t buf_size, size_t *read)
+static SCM
+read_complete_token (SCM port, size_t *read)
 {
-  *read = 0;
-
-  while (*read < buf_size)
-    {
-      scm_t_uint32 chr;
+  SCM buffer, str = SCM_EOL;
+  size_t len;
+  int overflow;
 
-      chr = scm_getc (port);
-      chr = (SCM_CASE_INSENSITIVE_P ? CHAR_DOWNCASE (chr) : chr);
+  buffer = scm_i_make_string (READER_BUFFER_SIZE, NULL); 
+  overflow = read_token (port, buffer, read);
+  if (!overflow)
+    return scm_c_substring (buffer, 0, *read);
 
-      if (chr == EOF)
-       return 0;
-      else if (CHAR_IS_DELIMITER (chr))
-       {
-         scm_ungetc (chr, port);
-         return 0;
-       }
-      else
-       {
-         *buf = chr;
-         buf++, (*read)++;
-       }
+  str = scm_string_copy (buffer);
+  do
+    {
+      overflow = read_token (port, buffer, &len);
+      str = scm_string_append (scm_list_2 (str, buffer));
+      *read += len;
     }
+  while (overflow);
 
-  return 1;
+  return scm_c_substring (str, 0, *read);
 }
 
-
 /* Skip whitespace from PORT and return the first non-whitespace character
    read.  Raise an error on end-of-file.  */
-static int
+static SCM
 flush_ws (SCM port, const char *eoferr)
 {
-  register int c;
-  while (1)
-    switch (c = scm_getc (port))
-      {
-      case EOF:
-      goteof:
-       if (eoferr)
-         {
-           scm_i_input_error (eoferr,
-                              port,
-                              "end of file",
-                              SCM_EOL);
-         }
-       return c;
-
-      case ';':
-      lp:
-       switch (c = scm_getc (port))
-         {
-         case EOF:
-           goto goteof;
-         default:
-           goto lp;
-         case SCM_LINE_INCREMENTORS:
-           break;
-         }
-       break;
+  SCM c,c2;
 
-      case '#':
-       switch (c = scm_getc (port))
-         {
-         case EOF:
-           eoferr = "read_sharp";
-           goto goteof;
-         case '!':
-           scm_read_scsh_block_comment (c, port);
-           break;
-         default:
-           scm_ungetc (c, port);
-           return '#';
-         }
-       break;
-
-      case SCM_LINE_INCREMENTORS:
-      case SCM_SINGLE_SPACES:
-      case '\t':
-       break;
+  while (1)
+    {
+      c = scm_read_char (port);
+      
+      if (SCM_EOF_OBJECT_P (c))
+       {
+         if (eoferr)
+           scm_i_input_error (eoferr, port, "end of file", SCM_EOL);
+         else
+           return SCM_EOF_VAL;
+       }
+      
+      if (SCM_CHAR_EQ (c, ';'))
+       {
+         while (1)
+           {
+             c2 = scm_read_char (port);
+             if (SCM_EOF_OBJECT_P (c2))
+               {
+                 if (eoferr)
+                   scm_i_input_error (eoferr, port, "end of file", SCM_EOL);
+                 else
+                   return SCM_EOF_VAL;
+               }
+             if (SCM_IS_LINE_INCREMENTOR (c2))
+               break;
+           }
+         continue;
+       }
+      
+      if (SCM_CHAR_EQ (c, '#'))
+       {
+         c2 = scm_read_char (port);
+         if (SCM_EOF_OBJECT_P (c2))
+           {
+             scm_i_input_error ("read_sharp", port, "end of file", SCM_EOL);
+           }
+         else if (SCM_CHAR_EQ (c2, '!'))
+           {
+             scm_read_scsh_block_comment (c2, port);
+             continue;
+           }
+         else
+           {
+             scm_unread_char (c2, port);
+             return SCM_MAKE_CHAR ('#');
+           }
+       }
+      
+      if (SCM_IS_LINE_INCREMENTOR (c) 
+         || SCM_IS_SINGLE_SPACE (c)
+         || SCM_CHAR_EQ (c, '\t'))
+       continue;
 
-      default:
-       return c;
-      }
+      return c;
+    }
 
-  return 0;
+  /* Unreachable. */
+  scm_i_input_error ("flush_ws", port, "internal reader error", SCM_EOL);
+  return SCM_BOOL_F;
 }
-
-
 
 /* Token readers.  */
 
 static SCM scm_read_expression (SCM port);
-static SCM scm_read_sharp (int chr, SCM port);
-static SCM scm_get_hash_procedure (int c);
+static SCM scm_read_sharp (SCM chr, SCM port);
+static SCM scm_get_hash_procedure (SCM c);
 static SCM recsexpr (SCM obj, long line, int column, SCM filename);
 
 
 static SCM
-scm_read_sexp (int chr, SCM port)
+scm_read_sexp (SCM chr, SCM port)
 #define FUNC_NAME "scm_i_lreadparen"
 {
-  register int c;
+  SCM c;
   register SCM tmp;
   register SCM tl, ans = SCM_EOL;
   SCM tl2 = SCM_EOL, ans2 = SCM_EOL, copy = SCM_BOOL_F;
@@ -328,22 +325,21 @@ scm_read_sexp (int chr, SCM port)
   long line = SCM_LINUM (port);
   int column = SCM_COL (port) - 1;
 
-
   c = flush_ws (port, FUNC_NAME);
-  if (terminating_char == c)
+  if (SCM_CHAR_EQ (c, terminating_char))
     return SCM_EOL;
 
-  scm_ungetc (c, port);
+  scm_unread_char (c, port);
   if (scm_is_eq (scm_sym_dot,
                 (tmp = scm_read_expression (port))))
     {
       ans = scm_read_expression (port);
-      if (terminating_char != (c = flush_ws (port, FUNC_NAME)))
+      c = flush_ws (port, FUNC_NAME);
+      if (!SCM_CHAR_EQ(c, terminating_char))
        scm_i_input_error (FUNC_NAME, port, "missing close paren",
                           SCM_EOL);
       return ans;
     }
-
   /* Build the head of the list structure. */
   ans = tl = scm_cons (tmp, SCM_EOL);
 
@@ -353,11 +349,11 @@ scm_read_sexp (int chr, SCM port)
                           : tmp,
                           SCM_EOL);
 
-  while (terminating_char != (c = flush_ws (port, FUNC_NAME)))
+  while (!SCM_CHAR_EQ((c = flush_ws (port, FUNC_NAME)), terminating_char))
     {
       SCM new_tail;
-
-      scm_ungetc (c, port);
+      
+      scm_unread_char (c, port);
       if (scm_is_eq (scm_sym_dot,
                     (tmp = scm_read_expression (port))))
        {
@@ -368,7 +364,7 @@ scm_read_sexp (int chr, SCM port)
                                       SCM_EOL));
 
          c = flush_ws (port, FUNC_NAME);
-         if (terminating_char != c)
+         if (!SCM_CHAR_EQ (c, terminating_char))
            scm_i_input_error (FUNC_NAME, port,
                               "in pair: missing close paren", SCM_EOL);
          goto exit;
@@ -422,7 +418,7 @@ static int
 update_octal_value (scm_t_uint32 *c, scm_t_uint32 digit) 
 {
   *c = *c << 3;
-  if ('0' <= digit && digit <= '9') 
+  if ('0' <= digit && digit <= '7') 
     *c += digit - '0';
   else
     return 0;
@@ -431,270 +427,238 @@ update_octal_value (scm_t_uint32 *c, scm_t_uint32 digit)
 }
 
 
-static scm_t_uint32
+static SCM
 scm_read_hex_escape (const char *func_name, SCM port)
 {
-  /* Read character with the syntax \xNN; where NN is a
-     hex number of 1 to 8 digits, and the semicolon
-     terminates the character escape.  */
-  int siz, i;
-  scm_t_uint32 c, d;
-  char digit[11];      /* slash + x + 8 digits + semicolon */
-
-  digit[0] = '\\';
-  digit[1] = 'x';
-  siz = 2;
-
-  while (siz < 11)
+  
+  /* If R6RS, read character with the syntax \xNN; where NN is a hex
+     number of 1 to 8 digits, and the semicolon terminates the
+     character escape.  
+     
+     If not R6RS, read character with the syntax \xNN. 
+  */
+
+  size_t len, i;
+  SCM chr;
+  char digit[8];
+  scm_t_uint32 c;
+
+  len = 0;
+  while (len < 8 && (SCM_R6RS_ESCAPES_P || len < 2))
     {
-      d = scm_getc (port);
-      if (d == (scm_t_uint32) EOF)
-       goto bad_hex_escaped;
-      if (!(isxdigit (d) || d == ';'))
-       goto bad_hex_escaped;
-
-      digit[siz] = (char) d;
-      siz++;
-      if (d == (scm_t_uint32)';')
+      chr = scm_read_char (port);
+      if (SCM_EOF_OBJECT_P (chr))
+       {
+         if (SCM_R6RS_ESCAPES_P)
+           goto unterminated;  /* EOL without semicolon */
+         else
+           break;
+       }
+
+      if (SCM_R6RS_ESCAPES_P && SCM_CHAR_EQ (chr, ';'))
        break;
+      else if (isxdigit (SCM_CHAR (chr)))
+       /* FIXME: use u32 version of isxdigit */
+       digit[len] = SCM_CHAR (chr);
+      else
+       goto bad_escaped;
+      
+      len ++;
     }
-  if (siz == 3 || siz > 11)
-    goto bad_hex_escaped;
-  c = 0;
-  for (i = 2; i < siz-1; i ++)
+
+  if (SCM_R6RS_ESCAPES_P && len == 0)
+    goto too_short;
+  if (SCM_R6RS_ESCAPES_P && len == 8)
     {
-      if (!update_hex_value (&c, digit[i]))
-       goto bad_hex_escaped;
+      chr = scm_read_char (port);
+      scm_unread_char (chr, port);
+      if (! SCM_CHAR_EQ (chr, ';'))
+       goto unterminated;
+    }
+  if (!SCM_R6RS_ESCAPES_P && len != 2)
+    {
+      if (SCM_EOF_OBJECT_P (chr))
+       goto too_short;
+      else
+       goto bad_escaped;               
     }
-  if ((c < 0) 
-      || (c > SCM_CODEPOINT_MAX)
-      || ((c >= SCM_CODEPOINT_SURROGATE_START)
-         && (c <= SCM_CODEPOINT_SURROGATE_END)))
-    goto bad_hex_escaped;
 
-  return c;
+  c = 0;
+  for (i = 0; i < len; i ++)
+      update_hex_value (&c, digit[i]);
 
- bad_hex_escaped:
-  scm_i_input_error (func_name, port, "invalid character escape ~a",
-                    scm_list_1 (scm_from_locale_stringn (digit,siz)));
+  if (c > SCM_CODEPOINT_MAX
+      || ((c >= SCM_CODEPOINT_SURROGATE_START)
+         && (c <= SCM_CODEPOINT_SURROGATE_END)))
+    scm_i_input_error (func_name, port, "hex escape is out of range: ~S",
+                      scm_list_1 (scm_from_uint32 (c)));
+  
+  return SCM_MAKE_CHAR (c);
 
+ bad_escaped:
+  scm_i_input_error (func_name, port, "illegal character in escape sequence: 
~S",
+                    scm_list_1 (chr));
+  
+ too_short:
+  scm_i_input_error (func_name, port,
+                    "invalid hex escape sequence (too short)",
+                    SCM_EOL);
+ unterminated:
+  scm_i_input_error (func_name, port,
+                    "unterminated hex escape sequence",
+                    SCM_EOL);
+  
   /* Never gets here.  */
-  return '?';
+  return SCM_MAKE_CHAR ('?');
 }
 
-
-
-
 static SCM
-scm_read_string (int chr, SCM port)
+scm_read_string (SCM chr, SCM port)
 #define FUNC_NAME "scm_lreadr"
 {
   /* For strings smaller than C_STR, this function creates only one Scheme
      object (the string returned).  */
-
+  
   SCM str = SCM_BOOL_F;
   unsigned c_str_len = 0;
-  scm_t_uint32 c;
-
-  str = scm_c_make_string (READER_STRING_BUFFER_SIZE, 
-                          SCM_MAKE_8BIT_CHAR ('0'));
-
-  while ('"' != (c = scm_getc (port)))
+  SCM c, c2;
+  
+  str = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL);
+  
+  while (1)
     {
-      if (c == (scm_t_uint32) EOF)
-       str_eof: scm_i_input_error (FUNC_NAME, port,
-                                   "end of file in string constant",
-                                   SCM_EOL);
+      c = scm_read_char (port);
+      if (SCM_EOF_OBJECT_P (c))
+       {
+       str_eof: 
+         scm_i_input_error (FUNC_NAME, port,
+                            "end of file in string constant",
+                            SCM_EOL);
+       }
+
+      if (SCM_CHAR_EQ (c, '"'))
+       break;
 
-      if ((c_str_len > 0)
-         && (c_str_len % READER_STRING_BUFFER_SIZE == 0))
+      if (c_str_len + 1 >= scm_i_string_length (str))
        {
          /* Expand the string buffer.  */
-         SCM addy = scm_c_make_string (READER_STRING_BUFFER_SIZE, 
-                                       SCM_MAKE_8BIT_CHAR ('0'));
-
+         SCM addy = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL);
+         
          str = scm_string_append (scm_list_2 (str, addy));
        }
+      
+      if (SCM_CHAR_EQ (c, '\\'))
+       {
+         c2 = scm_read_char (port);
 
-      if (c == '\\')
-       switch (c = scm_getc (port))
-         {
-         case (scm_t_uint32) EOF:
+         if (SCM_EOF_OBJECT_P (c2))
            goto str_eof;
-         case '"':
-         case '\\':
-           break;
-#if SCM_ENABLE_ELISP
-         case '(':
-         case ')':
-           if (SCM_ESCAPED_PARENS_P)
+
+         switch (SCM_CHAR (c2))
+           {
+           case '"':
+           case '\\':
+             c = c2;
              break;
-           goto bad_escaped;
+#if SCM_ENABLE_ELISP
+           case '(':
+           case ')':
+             if (SCM_ESCAPED_PARENS_P)
+               {
+                 c = c2;
+                 break;
+               }
+             goto bad_escaped;
 #endif
-         case '\n':
-           continue;
-         case '0':
-           c = '\0';
-           break;
-         case 'f':
-           c = '\f';
-           break;
-         case 'n':
-           c = '\n';
-           break;
-         case 'r':
-           c = '\r';
-           break;
-         case 't':
-           c = '\t';
-           break;
-         case 'a':
-           c = '\007';
-           break;
-         case 'b':
-           c = '\010';
-           break;
-         case 'v':
-           c = '\v';
-           break;
-         case 'x':
-           c = scm_read_hex_escape (FUNC_NAME, port);
-           break;
-         default:
-         bad_escaped:
-           scm_i_input_error (FUNC_NAME, port,
-                              "invalid character in escape sequence: ~S",
-                              scm_list_1 (SCM_MAKE_CHAR (c)));
-         }
-      scm_i_string_set (str, c_str_len, SCM_MAKE_CHAR (c));
-      c_str_len ++;
+           case '\n':
+             continue;
+           case '0':
+             c = SCM_MAKE_CHAR ('\0');
+             break;
+           case 'f':
+             c = SCM_MAKE_CHAR ('\f');
+             break;
+           case 'n':
+             c = SCM_MAKE_CHAR ('\n');
+             break;
+           case 'r':
+             c = SCM_MAKE_CHAR ('\r');
+             break;
+           case 't':
+             c = SCM_MAKE_CHAR ('\t');
+             break;
+           case 'a':
+             c = SCM_MAKE_CHAR ('\007');
+             break;
+           case 'v':
+             c = SCM_MAKE_CHAR ('\v');
+             break;
+           case 'b':
+             if (SCM_R6RS_ESCAPES_P)
+               {
+                 c = SCM_MAKE_CHAR ('\010');
+                 break;
+               }
+             goto bad_escaped;
+           case 'x':
+             c = scm_read_hex_escape (FUNC_NAME, port);
+             break;
+           default:
+           bad_escaped:
+             scm_i_input_error (FUNC_NAME, port,
+                                "illegal character in escape sequence: ~S",
+                                scm_list_1 (c2));
+           }
+       }
+      scm_i_string_set (str, c_str_len++, c);
     }
 
   if (c_str_len > 0)
     {
-      /* FIXME: would be better to truncate STR rather than making a
-        new truncated copy. */
       return scm_c_substring_copy (str, 0, c_str_len);
     }
-
+  
   return scm_nullstr;
 }
 #undef FUNC_NAME
 
 static SCM
-scm_read_number (int chr, SCM port)
+scm_read_number (SCM chr, SCM port)
 {
-  SCM result, str = SCM_EOL;
-  char buffer[READER_BUFFER_SIZE];
+  SCM result;
+  SCM buffer;
   size_t read;
-  int overflow = 0;
 
-  scm_ungetc (chr, port);
-  do
-    {
-      overflow = read_token2 (port, buffer, sizeof (buffer), &read);
+  scm_unread_char (chr, port);
+  buffer = read_complete_token (port, &read);
+  result = scm_string_to_number (buffer, SCM_UNDEFINED);
 
-      if ((overflow) || (scm_is_pair (str)))
-       str = scm_cons (scm_from_locale_stringn (buffer, read), str);
-    }
-  while (overflow);
-
-  if (scm_is_pair (str))
-    {
-      /* The slow path.  */
-
-      str = scm_string_concatenate (scm_reverse_x (str, SCM_EOL));
-      result = scm_string_to_number (str, SCM_UNDEFINED);
-      if (!scm_is_true (result))
-       /* Return a symbol instead of a number.  */
-       result = scm_string_to_symbol (str);
-    }
-  else
-    {
-      result = scm_c_locale_stringn_to_number (buffer, read, 10);
-      if (!scm_is_true (result))
-       /* Return a symbol instead of a number.  */
-       result = scm_from_locale_symboln (buffer, read);
-    }
+  if (!scm_is_true (result))
+    /* Return a symbol instead of a number.  */
+    result = scm_string_to_symbol (buffer);
 
   return result;
 }
 
 static SCM
-scm_read_mixed_case_symbol (char *func_name, int chr, SCM port)
+scm_read_mixed_case_symbol (char *func_name, SCM chr, SCM port)
 {
   SCM result, str = SCM_EOL;
   int ends_with_colon = 0;
-  scm_t_uint32 c;
-  unsigned c_str_len = 0;
   int postfix = scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_postfix);
+  size_t len;
 
-  str = scm_c_make_string (READER_BUFFER_SIZE, 
-                          SCM_MAKE_8BIT_CHAR ('0'));
-
-  scm_ungetc (chr, port);
-
-  while ((c = scm_getc (port)) != (scm_t_uint32) EOF)
-    {
-      c = (SCM_CASE_INSENSITIVE_P ? CHAR_DOWNCASE (c) : c);
-
-      if (CHAR_IS_DELIMITER (c))
-       {
-         scm_ungetc (c, port);
-         break;
-       }
-      if ((c_str_len > 0)
-         && (c_str_len % READER_BUFFER_SIZE == 0))
-       {
-         /* Expand the string buffer.  */
-         SCM addy = scm_c_make_string (READER_BUFFER_SIZE, 
-                                       SCM_MAKE_8BIT_CHAR ('0'));
-
-         str = scm_string_append (scm_list_2 (str, addy));
-       }
-
-      if (c == '\\')
-       switch (c = scm_getc (port))
-         {
-         case (scm_t_uint32) EOF:
-           scm_i_input_error (func_name, port,
-                              "invalid symbol terminator: ~S",
-                              scm_list_1 (SCM_MAKE_8BIT_CHAR ('\\')));
-#ifdef BRACKETS_AS_PARENS
-         case '[':
-         case ']':
-#endif
-         case '(':
-         case ')':
-         case '"':
-         case ';':
-         case '#':
-         case SCM_WHITE_SPACES:
-         case SCM_LINE_INCREMENTORS:
-         case '\\':
-           break;
-         case 'x':
-           c = scm_read_hex_escape (func_name, port);
-           break;
-         default:
-           scm_i_input_error (func_name, port,
-                              "invalid character in escape sequence: ~S",
-                              scm_list_1 (SCM_MAKE_CHAR (c)));
-         }
-      scm_i_string_set (str, c_str_len, SCM_MAKE_CHAR (c));
-      c_str_len ++;
-    }
-
-  ends_with_colon = scm_i_string_ref_eq_char (str, c_str_len - 1, ':');
-
-  str =  scm_c_substring_copy (str, 0, c_str_len);
+  scm_unread_char (chr, port);
+  str = read_complete_token (port, &len);
+  if (len > 0)
+    ends_with_colon = scm_i_string_ref_eq_char (str, len - 1, ':');
 
   /* Per SRFI-88, `:' alone is an identifier, not a keyword.  */
-  if (postfix && ends_with_colon && (scm_i_string_length (str) > 1))
+  if (postfix && ends_with_colon && (len > 1))
     {
       /* This is a string that ends in a colon that is meant to be a
-        keyword.  The colon gets stripped off before conversion.  */
-      str = scm_c_substring (str, 0, c_str_len - 1);
+         keyword.  The colon gets stripped off before conversion.  */
+      str = scm_c_substring (str, 0, len - 1);
       result = scm_symbol_to_keyword (scm_string_to_symbol (str));
     }
   else
@@ -704,27 +668,25 @@ scm_read_mixed_case_symbol (char *func_name, int chr, SCM 
port)
 }
 
 static SCM
-scm_read_number_and_radix (int chr, SCM port)
+scm_read_number_and_radix (SCM chr, SCM port)
 #define FUNC_NAME "scm_lreadr"
 {
   SCM result, str = SCM_EOL;
   size_t read;
-  char buffer[READER_BUFFER_SIZE];
   unsigned int radix;
-  int overflow = 0;
 
-  switch (chr)
+  switch (SCM_CHAR (chr))
     {
     case 'B':
     case 'b':
       radix = 2;
       break;
-
+      
     case 'o':
     case 'O':
       radix = 8;
       break;
-
+      
     case 'd':
     case 'D':
       radix = 10;
@@ -736,28 +698,13 @@ scm_read_number_and_radix (int chr, SCM port)
       break;
 
     default:
-      scm_ungetc (chr, port);
+      scm_unread_char (chr, port);
       scm_ungetc ('#', port);
       radix = 10;
     }
 
-  do
-    {
-      overflow = read_token2 (port, buffer, sizeof (buffer), &read);
-
-      if ((overflow) || (scm_is_pair (str)))
-       str = scm_cons (scm_from_locale_stringn (buffer, read), str);
-    }
-  while (overflow);
-
-  if (scm_is_pair (str))
-    {
-      str = scm_string_concatenate (scm_reverse_x (str, SCM_EOL));
-      result = scm_string_to_number (str, scm_from_uint (radix));
-    }
-  else
-    result = scm_c_locale_stringn_to_number (buffer, read, radix);
-
+  str = read_complete_token (port, &read);
+  result = scm_string_to_number (str, scm_from_uint (radix));
   if (scm_is_true (result))
     return result;
 
@@ -768,32 +715,34 @@ scm_read_number_and_radix (int chr, SCM port)
 #undef FUNC_NAME
 
 static SCM
-scm_read_quote (int chr, SCM port)
+scm_read_quote (SCM chr, SCM port)
 {
   SCM p;
   long line = SCM_LINUM (port);
   int column = SCM_COL (port) - 1;
 
-  switch (chr)
+  switch (SCM_CHAR (chr))
     {
     case '`':
       p = scm_sym_quasiquote;
       break;
-
+      
     case '\'':
       p = scm_sym_quote;
       break;
 
     case ',':
       {
-       int c;
-
-       c = scm_getc (port);
-       if ('@' == c)
+       SCM c;
+       
+       c = scm_read_char (port);
+       if (SCM_EOF_OBJECT_P (c))
+         scm_i_input_error ("scm_read_quote", port, "end of file", SCM_EOL);
+       if (SCM_CHAR_EQ (c, '@'))
          p = scm_sym_uq_splicing;
        else
          {
-           scm_ungetc (c, port);
+           scm_unread_char(c, port);
            p = scm_sym_unquote;
          }
        break;
@@ -801,7 +750,7 @@ scm_read_quote (int chr, SCM port)
 
     default:
       fprintf (stderr, "%s: unhandled quote character (%i)\n",
-              "scm_read_quote", chr);
+              "scm_read_quote", SCM_CHAR (chr));
       abort ();
     }
 
@@ -822,13 +771,13 @@ scm_read_quote (int chr, SCM port)
 }
 
 static inline SCM
-scm_read_semicolon_comment (int chr, SCM port)
+scm_read_semicolon_comment (SCM chr, SCM port)
 {
-  int c;
+  SCM c;
 
-  for (c = scm_getc (port);
-       (c != EOF) && (c != '\n');
-       c = scm_getc (port));
+  for (c = scm_read_char (port);
+       !SCM_EOF_OBJECT_P (c) && !SCM_CHAR_EQ (c, 'n');
+       c = scm_read_char (port));
 
   return SCM_UNSPECIFIED;
 }
@@ -837,9 +786,9 @@ scm_read_semicolon_comment (int chr, SCM port)
 /* Sharp readers, i.e. readers called after a `#' sign has been read.  */
 
 static SCM
-scm_read_boolean (int chr, SCM port)
+scm_read_boolean (SCM chr, SCM port)
 {
-  switch (chr)
+  switch (SCM_CHAR (chr))
     {
     case 't':
     case 'T':
@@ -854,58 +803,63 @@ scm_read_boolean (int chr, SCM port)
 }
 
 static SCM
-scm_read_character (int chr, SCM port)
+scm_read_character (SCM chr, SCM port)
 #define FUNC_NAME "scm_lreadr"
 {
   unsigned i;
-  scm_t_uint32 charname[READER_CHAR_NAME_MAX_SIZE], c;
+  SCM charname;
   size_t charname_len;
   scm_t_uint32 val;
   SCM p;
+  scm_t_uint32 c;
+  
+  charname = scm_i_make_string (READER_CHAR_NAME_MAX_SIZE, NULL);
 
-  if (read_token (port, charname, sizeof (charname), &charname_len))
+  /* Error if the character name is too long.  */
+  if (read_token (port, charname, &charname_len))
     goto char_error;
 
+  charname = scm_c_substring (charname, 0, charname_len);
+
   if (charname_len == 0)
     {
-      chr = scm_getc (port);
-      if (chr == EOF)
+      chr = scm_read_char (port);
+      if (SCM_EOF_OBJECT_P (chr))
        scm_i_input_error (FUNC_NAME, port, "unexpected end of file "
                           "while reading character", SCM_EOL);
 
       /* CHR must be a token delimiter, like a whitespace.  */
-      return (SCM_MAKE_CHAR (chr));
+      return (chr);
     }
 
   if (charname_len == 1)
-    return SCM_MAKE_CHAR (charname[0]);
+    return scm_i_string_ref (charname, 0);
 
   /* Handle characters in R6RS hex format.  */
   p = SCM_BOOL_F;
-  if (charname[0] == 'x')
+  if (SCM_R6RS_ESCAPES_P && scm_i_string_ref_eq_char (charname, 0, 'x'))
     {
       val = 0;
       for (i = 1; i < charname_len; i++)
        {
-         c = charname[i];
+         c = scm_i_string_ref_to_uint32 (charname, i);
          if (!update_hex_value (&val, c))
            scm_i_input_error (FUNC_NAME, port, "invalid character escape ~a",
-                              scm_list_1 (scm_from_utf32_stringn (charname, 
-                                                                  
charname_len)));
+                              scm_list_1 (charname));
        }
       p = scm_from_uint32 (val);
     }
-  else if (*charname >= '0' && *charname < '8')
+  else if (scm_i_string_ref_to_char (charname, 0, '?') >= '0' 
+          && scm_i_string_ref_to_char (charname, 0, '?') < '8')
     {
       /* Handle characters in the Guile-extension octal format.  */
       val = 0;
       for (i = 0; i < charname_len; i++)
        {
-         c = charname[i];
+         c = scm_i_string_ref_to_uint32 (charname, i);
          if (!update_octal_value (&val, c))
            scm_i_input_error (FUNC_NAME, port, "invalid character escape ~a",
-                              scm_list_1 (scm_from_utf32_stringn (charname, 
-                                                                  
charname_len)));
+                              scm_list_1 (charname));
        }
       p = scm_from_uint32 (val);
     }
@@ -918,41 +872,32 @@ scm_read_character (int chr, SCM port)
        return scm_integer_to_char (p);
       else
        scm_i_input_error (FUNC_NAME, port, "out of range character escape ~a",
-                          scm_list_1 (scm_from_utf32_stringn (charname, 
-                                                              charname_len)));
+                          scm_list_1 (charname));
     }
        
 
   /* Lookup named character.  */
   {
-    /* FIXME: do this in uint32.  */
-    char *str = scm_malloc (charname_len +1);
-    int i;
+    SCM ch;
 
-    for(i = 0; i < charname_len; i++)
-      {
-       if (charname[i] > 127)
-         goto char_error;
-       str[i] = charname[i];
-      }
-    str[charname_len] = '\0';
-    SCM ch = scm_i_charname_to_char (str, charname_len);
-    free (str);
+    if (!scm_i_is_narrow_string (charname))
+      goto char_error;
+
+    ch = scm_i_charname_to_char (scm_i_string_chars (charname), charname_len);
     if (scm_is_true (ch))
       return ch;
   }
 
  char_error:
   scm_i_input_error (FUNC_NAME, port, "unknown character name ~a",
-                    scm_list_1 (scm_from_utf32_stringn (charname,
-                                                        charname_len)));
+                    scm_list_1 (charname));
 
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
 static inline SCM
-scm_read_keyword (int chr, SCM port)
+scm_read_keyword (SCM chr, SCM port)
 {
   SCM symbol;
 
@@ -965,13 +910,13 @@ scm_read_keyword (int chr, SCM port)
   if (!scm_is_symbol (symbol))
     scm_i_input_error ("scm_read_keyword", port,
                       "keyword prefix `~a' not followed by a symbol: ~s",
-                      scm_list_2 (SCM_MAKE_CHAR (chr), symbol));
+                      scm_list_2 (chr, symbol));
 
   return (scm_symbol_to_keyword (symbol));
 }
 
 static inline SCM
-scm_read_vector (int chr, SCM port)
+scm_read_vector (SCM chr, SCM port)
 {
   /* Note: We call `scm_read_sexp ()' rather than READER here in order to
      guarantee that it's going to do what we want.  After all, this is an
@@ -981,47 +926,49 @@ scm_read_vector (int chr, SCM port)
 }
 
 static inline SCM
-scm_read_srfi4_vector (int chr, SCM port)
+scm_read_srfi4_vector (SCM chr, SCM port)
 {
-  return scm_i_read_array (port, chr);
+  return scm_i_read_array (port, SCM_CHAR (chr));
 }
 
 static SCM
-scm_read_guile_bit_vector (int chr, SCM port)
+scm_read_guile_bit_vector (SCM chr, SCM port)
 {
   /* Read the `#*10101'-style read syntax for bit vectors in Guile.  This is
      terribly inefficient but who cares?  */
   SCM s_bits = SCM_EOL;
 
-  for (chr = scm_getc (port);
-       (chr != EOF) && ((chr == '0') || (chr == '1'));
-       chr = scm_getc (port))
+  for (chr = scm_read_char (port);
+       !SCM_EOF_OBJECT_P (chr) 
+        && (SCM_CHAR_EQ (chr, '0') || SCM_CHAR_EQ (chr, '1'));
+       chr = scm_read_char (port))
     {
-      s_bits = scm_cons ((chr == '0') ? SCM_BOOL_F : SCM_BOOL_T, s_bits);
+      s_bits = scm_cons (SCM_CHAR_EQ (chr, '0') ? SCM_BOOL_F : SCM_BOOL_T, 
+                        s_bits);
     }
 
-  if (chr != EOF)
-    scm_ungetc (chr, port);
+  if (!SCM_EOF_OBJECT_P (chr))
+    scm_unread_char (chr, port);
 
   return scm_bitvector (scm_reverse_x (s_bits, SCM_EOL));
 }
 
 static inline SCM
-scm_read_scsh_block_comment (int chr, SCM port)
+scm_read_scsh_block_comment (SCM chr, SCM port)
 {
   int bang_seen = 0;
 
   for (;;)
     {
-      int c = scm_getc (port);
+      SCM c = scm_read_char (port);
 
-      if (c == EOF)
+      if (SCM_EOF_OBJECT_P (c))
        scm_i_input_error ("skip_block_comment", port,
                           "unterminated `#! ... !#' comment", SCM_EOL);
 
-      if (c == '!')
+      if (SCM_CHAR_EQ (c, '!'))
        bang_seen = 1;
-      else if (c == '#' && bang_seen)
+      else if (SCM_CHAR_EQ (c, '#') && bang_seen)
        break;
       else
        bang_seen = 0;
@@ -1031,25 +978,24 @@ scm_read_scsh_block_comment (int chr, SCM port)
 }
 
 static SCM
-scm_read_extended_symbol (int chr, SCM port)
+scm_read_extended_symbol (SCM chr, SCM port)
 {
   /* Guile's extended symbol read syntax looks like this:
 
        #{This is all a symbol name}#
 
      So here, CHR is expected to be `{'.  */
-  SCM result;
   int saw_brace = 0, finished = 0;
   size_t len = 0;
-  char buf[1024];
+  SCM buf;
 
-  result = scm_c_make_string (0, SCM_MAKE_CHAR ('X'));
+  buf = scm_i_make_string (1024, NULL);
 
-  while ((chr = scm_getc (port)) != EOF)
+  while (!SCM_EOF_OBJECT_P (chr = scm_read_char (port)))
     {
       if (saw_brace)
        {
-         if (chr == '#')
+         if (SCM_CHAR_EQ (chr, '#'))
            {
              finished = 1;
              break;
@@ -1057,20 +1003,19 @@ scm_read_extended_symbol (int chr, SCM port)
          else
            {
              saw_brace = 0;
-             buf[len++] = '}';
-             buf[len++] = chr;
+             scm_i_string_set (buf, len++, SCM_MAKE_CHAR ('}'));
+             scm_i_string_set (buf, len++, chr);
            }
        }
-      else if (chr == '}')
+      else if (SCM_CHAR_EQ (chr, '}'))
        saw_brace = 1;
       else
-       buf[len++] = chr;
+       scm_i_string_set (buf, len++, chr);
 
-      if (len >= sizeof (buf) - 2)
+      if (len >= scm_i_string_length (buf) - 2)
        {
-         scm_string_append (scm_list_2 (result,
-                                        scm_from_locale_stringn (buf, len)));
-         len = 0;
+         SCM addy = scm_i_make_string (1024, NULL);
+         buf = scm_string_append (scm_list_2 (buf, addy));
        }
 
       if (finished)
@@ -1078,11 +1023,9 @@ scm_read_extended_symbol (int chr, SCM port)
     }
 
   if (len)
-    result = scm_string_append (scm_list_2
-                               (result,
-                                scm_from_locale_stringn (buf, len)));
+    return scm_string_to_symbol (scm_c_substring (buf, 0, len));
 
-  return (scm_string_to_symbol (result));
+  return (scm_string_to_symbol (scm_nullstr));
 }
 
 
@@ -1090,7 +1033,7 @@ scm_read_extended_symbol (int chr, SCM port)
 /* Top-level token readers, i.e., dispatchers.  */
 
 static SCM
-scm_read_sharp_extension (int chr, SCM port)
+scm_read_sharp_extension (SCM chr, SCM port)
 {
   SCM proc;
 
@@ -1101,7 +1044,7 @@ scm_read_sharp_extension (int chr, SCM port)
       int column = SCM_COL (port) - 2;
       SCM got;
 
-      got = scm_call_2 (proc, SCM_MAKE_CHAR (chr), port);
+      got = scm_call_2 (proc, chr, port);
       if (!scm_is_eq (got, SCM_UNSPECIFIED))
        {
          if (SCM_RECORD_POSITIONS_P)
@@ -1118,18 +1061,21 @@ scm_read_sharp_extension (int chr, SCM port)
 /* The reader for the sharp `#' character.  It basically dispatches reads
    among the above token readers.   */
 static SCM
-scm_read_sharp (int chr, SCM port)
+scm_read_sharp (SCM chr, SCM port)
 #define FUNC_NAME "scm_lreadr"
 {
   SCM result;
 
-  chr = scm_getc (port);
+  chr = scm_read_char (port);
 
+  if (SCM_EOF_OBJECT_P (chr))
+    scm_i_input_error (FUNC_NAME, port, "end of file", SCM_EOL);
+  
   result = scm_read_sharp_extension (chr, port);
   if (!scm_is_eq (result, SCM_UNSPECIFIED))
     return result;
 
-  switch (chr)
+  switch (SCM_CHAR (chr))
     {
     case '\\':
       return (scm_read_character (chr, port));
@@ -1160,7 +1106,7 @@ scm_read_sharp (int chr, SCM port)
     case 'h':
     case 'l':
 #endif
-      return (scm_i_read_array (port, chr));
+      return (scm_i_read_array (port, SCM_CHAR (chr)));
 
     case 'i':
     case 'e':
@@ -1168,11 +1114,11 @@ scm_read_sharp (int chr, SCM port)
       {
        /* When next char is '(', it really is an old-style
           uniform array. */
-       int next_c = scm_getc (port);
-       if (next_c != EOF)
-         scm_ungetc (next_c, port);
-       if (next_c == '(')
-         return scm_i_read_array (port, chr);
+       SCM next_c = scm_read_char (port);
+       if (!SCM_EOF_OBJECT_P (next_c))
+         scm_unread_char (next_c, port);
+       if (SCM_CHAR_EQ (next_c, '('))
+         return scm_i_read_array (port, SCM_CHAR (chr));
        /* Fall through. */
       }
 #endif
@@ -1195,7 +1141,7 @@ scm_read_sharp (int chr, SCM port)
       result = scm_read_sharp_extension (chr, port);
       if (scm_is_eq (result, SCM_UNSPECIFIED))
        scm_i_input_error (FUNC_NAME, port, "Unknown # object: ~S",
-                          scm_list_1 (SCM_MAKE_CHAR (chr)));
+                          scm_list_1 (chr));
       else
        return result;
     }
@@ -1208,13 +1154,19 @@ static SCM
 scm_read_expression (SCM port)
 #define FUNC_NAME "scm_read_expression"
 {
+  SCM chr;
+  scm_t_uint32 c;
+
   while (1)
     {
-      register int chr;
+      chr = scm_read_char (port);
+
+      if (SCM_EOF_OBJECT_P (chr))
+       return SCM_EOF_VAL;
 
-      chr = scm_getc (port);
+      c = SCM_CHAR (chr);
 
-      switch (chr)
+      switch (c)
        {
        case SCM_WHITE_SPACES:
        case SCM_LINE_INCREMENTORS:
@@ -1243,8 +1195,6 @@ scm_read_expression (SCM port)
        case ')':
          scm_i_input_error (FUNC_NAME, port, "unexpected \")\"", SCM_EOL);
          break;
-       case EOF:
-         return SCM_EOF_VAL;
        case ':':
          if (scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix))
            return scm_symbol_to_keyword (scm_read_expression (port));
@@ -1252,8 +1202,8 @@ scm_read_expression (SCM port)
 
        default:
          {
-           if (((chr >= '0') && (chr <= '9'))
-               || (strchr ("+-.", chr)))
+           if (((c >= '0') && (c <= '9'))
+               || (strchr ("+-.", c)))
              return (scm_read_number (chr, port));
            else
              return (scm_read_mixed_case_symbol (FUNC_NAME, chr, port));
@@ -1273,16 +1223,16 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0,
            "Any whitespace before the next token is discarded.")
 #define FUNC_NAME s_scm_read
 {
-  int c;
+  SCM c;
 
   if (SCM_UNBNDP (port))
     port = scm_current_input_port ();
   SCM_VALIDATE_OPINPORT (1, port);
 
   c = flush_ws (port, (char *) NULL);
-  if (EOF == c)
+  if (SCM_EOF_OBJECT_P (c))
     return SCM_EOF_VAL;
-  scm_ungetc (c, port);
+  scm_unread_char (c, port);
 
   return (scm_read_expression (port));
 }
@@ -1405,7 +1355,7 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 
0, 0,
 
 /* Recover the read-hash procedure corresponding to char c.  */
 static SCM
-scm_get_hash_procedure (int c)
+scm_get_hash_procedure (SCM c)
 {
   SCM rest = *scm_read_hash_procedures;
 
@@ -1414,7 +1364,7 @@ scm_get_hash_procedure (int c)
       if (scm_is_null (rest))
        return SCM_BOOL_F;
   
-      if (SCM_CHAR (SCM_CAAR (rest)) == c)
+      if (scm_is_true (scm_char_eq_p (SCM_CAAR (rest), c)))
        return SCM_CDAR (rest);
      
       rest = SCM_CDR (rest);
diff --git a/libguile/read.h b/libguile/read.h
index 4253622..9e15306 100644
--- a/libguile/read.h
+++ b/libguile/read.h
@@ -36,11 +36,17 @@
  */
 
 #define SCM_LINE_INCREMENTORS  '\n'
+#define SCM_IS_LINE_INCREMENTOR(c) (SCM_CHAR_EQ(c, '\n'))
 
 #ifdef MSDOS
 # define SCM_SINGLE_SPACES  ' ':case '\r':case '\f': case 26
+# define SCM_IS_SINGLE_SPACE(c) \
+  (SCM_CHAR_EQ(c, ' ') || SCM_CHAR_EQ(c, '\r') || SCM_CHAR_EQ(c, '\f') \
+   || SCM_CHAR_EQ(c, 26))
 #else
 # define SCM_SINGLE_SPACES  ' ':case '\r':case '\f'
+# define SCM_IS_SINGLE_SPACE(c) \
+  (SCM_CHAR_EQ(c, ' ') || SCM_CHAR_EQ(c, '\r') || SCM_CHAR_EQ(c, '\f'))
 #endif
 
 #define SCM_WHITE_SPACES  SCM_SINGLE_SPACES: case '\t'
diff --git a/libguile/strings.c b/libguile/strings.c
index bb1c17c..6b8a0dd 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1401,6 +1401,8 @@ scm_i_symbol_name_to_write_string (SCM sym, int 
quote_key_flag)
          else
            olen ++;
        }
+      else if (weird && c == '\\')
+       olen += 2;
       else if (is_printable_ascii (c))
        olen ++;
       else
@@ -1428,6 +1430,11 @@ scm_i_symbol_name_to_write_string (SCM sym, int 
quote_key_flag)
          else
            odata[j++] = c;
        }
+      else if (weird && c == '\\')
+       {
+         odata[j++] = '\\';
+         odata[j++] = '\\';
+       }
       else if (is_printable_ascii (c))
        {
          /* These chars are printable ASCII */
@@ -1875,6 +1882,9 @@ scm_from_locale_stringn (const char *str, size_t len)
   if (len == (size_t)-1)
     len = strlen (str);
 
+  if (len == 0)
+    return scm_nullstr;
+
 #ifdef SCM_DEBUG_WIDE_STRING
   if ((unsigned char)str[0] >= 160)
     {
diff --git a/libguile/symbols.c b/libguile/symbols.c
index fe6bc84..f903baf 100644
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -372,11 +372,11 @@ scm_i_is_keywordish_symbol (SCM str)
   if (len == 0)
     return 0;
 
-  if (!scm_i_symbol_ref_eq_char (str, 0, ':')
-      && !scm_i_symbol_ref_eq_char (str, len - 1, ':'))
-    return 0;
+  if (scm_i_symbol_ref_eq_char (str, 0, ':')
+      || scm_i_symbol_ref_eq_char (str, len - 1, ':'))
+    return 1;
 
-  return 1;
+  return 0;
 }
 
 SCM
diff --git a/test-suite/tests/chars-r6rs.test b/test-suite/tests/chars-r6rs.test
new file mode 100644
index 0000000..9c09cf5
--- /dev/null
+++ b/test-suite/tests/chars-r6rs.test
@@ -0,0 +1,226 @@
+;;;; -*- mode: scheme; coding: utf-8; -*-
+;;;; chars.test -- unit test for character functions
+;;;; 
+;;;; Greg J. Badros <address@hidden>
+;;;;
+;;;;   Copyright (C) 2000, 2006, 2009 Free Software Foundation, Inc.
+;;;; 
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2, or (at your option)
+;;;; any later version.
+;;;; 
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this software; see the file COPYING.  If not, write to
+;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
+
+
+(use-modules (test-suite lib)
+            (srfi srfi-1))
+
+(setlocale LC_ALL "")
+(read-enable 'r6rs-escapes)
+
+(define exception:wrong-type-to-apply
+  (cons 'misc-error "^Wrong type to apply:"))
+(define exception:read-error
+  (cons 'read-error "^.*"))
+
+;; Named characters
+;; R6RS named characters are case-sensitive
+(with-test-prefix "R6RS character names"
+
+  (pass-if "#\\nul is U+0000"
+          (eqv? #x00 (char->integer #\nul)))
+  
+  (pass-if "#\\alarm is U+0007"
+          (eqv? #x07 (char->integer #\alarm)))
+  
+  (pass-if "#\\backspace is U+0008"
+          (eqv? #x08 (char->integer #\backspace)))
+  
+  (pass-if "#\\tab is U+0009"
+          (eqv? #x09 (char->integer #\tab)))
+  
+  (pass-if "#\\linefeed is U+000A"
+          (eqv? #x0A (char->integer #\linefeed)))
+  
+  (pass-if "#\\vtab is U+000B"
+          (eqv? #x0B (char->integer #\vtab)))
+  
+  (pass-if "#\\page is U+000C"
+          (eqv? #x0C (char->integer #\page)))
+  
+  (pass-if "#\\return is U+000D"
+          (eqv? #x0D (char->integer #\return)))
+  
+  (pass-if "#\\esc is U+001B"
+          (eqv? #x1B (char->integer #\esc)))
+  
+  (pass-if "#\\space is U+0020"
+          (eqv? #x20 (char->integer #\space)))
+  
+  (pass-if "#\\delete is U+007F"
+          (eqv? #x7F (char->integer #\delete)))
+  
+  (pass-if-exception "non-existent named character #\\foobar" 
exception:read-error
+                    (with-input-from-string "#\\foobar" read))
+  
+  (pass-if-exception "R6RS character names are case sensitive" 
exception:read-error
+                    (with-input-from-string "#\\Alarm" read))
+  
+  (pass-if-exception "character names match entire token" exception:read-error
+                    (with-input-from-string "#\\alarmz" read))
+  
+  ;; R6RS hex escapes
+  (pass-if "#\\xFF is U+00FF when R6RS escapes are enabled"
+          (eqv? #xFF (char->integer #\xFF)))
+  
+  (pass-if "#\\x03BB is U+03BB"
+          (eqv? #x03BB (char->integer #\x03BB)))
+  
+  (pass-if "#\\x00006587 is U+6587"
+          (eqv? #x6587 (char->integer #\x00006587)))
+  
+  (pass-if-exception "#\\x0001z is exception" exception:read-error
+                    (with-input-from-string "#\\x0001z" read))
+  
+  (pass-if "'#\\alarm x' is U+0007 followed by x"
+          (let ((x #\a))
+            (eqv? (string-ref (string #\alarm x) 0)
+                  #\x07)))
+  
+  (pass-if "#\\xff is U+00FF"
+          (eqv? #xff (char->integer #\xff)))
+  
+  (pass-if "'#\\x ff' is U+0078 followed by the datum 'ff'"
+          (let ((ff #\a))
+            (eqv? (string-ref (string #\x ff) 0)
+                  #\x)))
+  
+  (pass-if-exception "#\\x00110000 is exception" exception:read-error
+                    (with-input-from-string "#\\x00110000" read))
+  
+  (pass-if "#\\x000000001 is U+0001"
+          (eqv? #x01 (char->integer #\x000000001)))
+  
+  (pass-if-exception "#\\xD800 is exception" exception:read-error
+                    (with-input-from-string "#\\xD800" read))
+  
+  ;; Deprecated but still legal R6RS handling
+  (pass-if "#\\  is U+0020"
+          (eqv? #x20 (char->integer #\ )))
+  (pass-if "#\\newline is U+000A"
+          (eqv? #x0A (char->integer #\newline))))
+
+;; R6RS non-ASCII character names
+;; Greek lambda encoded in UTF-8 in source file
+;;(pass-if "#\\λ is U+03BB"
+;;      (eqv? #x03BB (char->integer #\λ)))
+
+(with-test-prefix 
+ "Character names"
+ (pass-if "C1 controls"
+         (list= eqv?
+                (list
+                 #\bph #\nbh #\ind #\nel #\ssa #\esa
+                 #\hts #\htj #\vts #\pld #\plu #\ri  #\ss2 #\ss3
+                 #\dcs #\pu1 #\pu2 #\sts #\cch #\mw  #\spa #\epa
+                 #\sos #\sci #\csi #\st  #\osc #\pm  #\apc
+                 #\nbsp #\shy)
+                (list
+                 #\x82 #\x83 #\x84 #\x85 #\x86 #\x87
+                 #\x88 #\x89 #\x8A #\x8B #\x8C #\x8D #\x8E #\x8F
+                 #\x90 #\x91 #\x92 #\x93 #\x94 #\x95 #\x96 #\x97
+                 #\x98 #\x9A #\x9B #\x9C #\x9D #\x9E #\x9F
+                 #\xA0 #\xAD))))
+
+;; Octal character escapes
+(with-test-prefix "Escapes"
+(pass-if "octal equals hex"
+        (list= (eqv?
+                (list #\000 #\010 #\020 #\030)
+                (list #\x00 #\x08 #\x10 #\x18)))))
+                
+
+;;;;;;;;;;
+;; Write format of characters
+
+(with-test-prefix "character write format"
+
+  (pass-if "ISO-8859-1 characters"
+    (let* ((lst (map integer->char (iota 128 128)))
+          (str (with-output-to-string (lambda () (write lst)))))
+      (list= eqv? 
+            lst
+            (with-input-from-string str read)))))
+
+;;;;;;;;;;
+;; Basic character functions
+(with-test-prefix "R6RS character procedures"
+
+(pass-if "char? #\\a is true"
+        (eq? #t (char? #\a)))
+(pass-if "char? #f is false"
+        (eq? #f (char? #f)))
+(pass-if "char->integer #\\a returns U+0061"
+        (= (char->integer #\a) #x61))
+(pass-if "integer->char 0"
+        (eq? #\nul (integer->char 0)))
+(pass-if "integer->char #xD7FF"
+        (eq? #\xd7ff (integer->char #xd7ff)))
+(pass-if "integer->char #xE000"
+        (eq? #\xe000 (integer->char #xe000)))
+(pass-if "integer->char #x10FFFF"
+        (eq? #\x10ffff (integer->char #x10ffff)))
+(pass-if-exception "integer->char -1 should fail" exception:out-of-range
+                  (integer->char -1))
+(pass-if-exception "integer->char #xd800 should fail" exception:out-of-range
+                  (integer->char #xd800))
+(pass-if-exception "integer->char #xdfff should fail" exception:out-of-range
+                  (integer->char #xdfff))
+(pass-if-exception "integer->char #x1a0000 should fail" exception:out-of-range
+                  (integer->char #x1a0000))
+
+(pass-if "char=? a a a"
+        (eq? #t (char=? #\a #\a #\a)))
+(pass-if "char=? space a a-grave"
+        (eq? #f (char=? #\space #\a #\xe0)))
+(pass-if "char=? a-grave a space"
+        (eq? #f (char=? #\xe0 #\a #\space)))
+
+(pass-if "char<? a a a"
+        (eq? #f (char<? #\a #\a #\a)))
+(pass-if "char<? space a a-grave"
+        (eq? #t (char<? #\space #\a #\xe0)))
+(pass-if "char<? a-grave a space"
+        (eq? #f (char<? #\xe0 #\a #\space)))
+
+(pass-if "char>? a a a"
+        (eq? #f (char>? #\a #\a #\a)))
+(pass-if "char>? space a a-grave"
+        (eq? #f (char>? #\space #\a #\xe0)))
+(pass-if "char>? a-grave a space"
+        (eq? #t (char>? #\xe0 #\a #\space)))
+
+(pass-if "char<=? a a a"
+        (eq? #t (char<=? #\a #\a #\a)))
+(pass-if "char<=? space a a-grave"
+        (eq? #t (char<=? #\space #\a #\xe0)))
+(pass-if "char<=? a-grave a space"
+        (eq? #f (char<=? #\xe0 #\a #\space)))
+
+(pass-if "char>=? a a a"
+        (eq? #t (char>=? #\a #\a #\a)))
+(pass-if "char>=? space a a-grave"
+        (eq? #f (char>=? #\space #\a #\xe0)))
+(pass-if "char>=? a-grave a space"
+        (eq? #t (char>=? #\xe0 #\a #\space))))
+
+
diff --git a/test-suite/tests/chars.test b/test-suite/tests/chars.test
index 2b13262..184df82 100644
--- a/test-suite/tests/chars.test
+++ b/test-suite/tests/chars.test
@@ -1,9 +1,7 @@
-;;;; -*- mode: scheme; coding: utf-8; -*-
-;;;; chars.test -- unit test for character functions
-;;;; 
+;;;; chars.test --- test suite for Guile's char functions    -*- scheme -*-
 ;;;; Greg J. Badros <address@hidden>
 ;;;;
-;;;;   Copyright (C) 2000, 2006, 2009 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2000, 2006 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -24,15 +22,13 @@
 (use-modules (test-suite lib)
             (srfi srfi-1))
 
-(setlocale LC_ALL "")
+(read-disable 'r6rs-escapes)
 
 (define exception:wrong-type-to-apply
   (cons 'misc-error "^Wrong type to apply:"))
-(define exception:read-error
-  (cons 'read-error "^.*"))
 
 (with-test-prefix "basic char handling"
-                 
+
   (with-test-prefix "evaluator"
 
     ;; The following test makes sure that the evaluator distinguishes between
@@ -41,167 +37,52 @@
       exception:wrong-type-to-apply
       (eval '(#\0) (interaction-environment)))))
 
-;;;;;;;;;;
-;; R6RS
+(pass-if "char-is-both? works"
+        (and
+         (not (char-is-both? #\?))
+         (not (char-is-both? #\newline))
+         (char-is-both? #\a)
+         (char-is-both? #\Z)
+         (not (char-is-both? #\1))))
 
-(with-test-prefix "character read syntax"
+(with-test-prefix "Basic character read syntax"
 ;; Basic character handling
-(pass-if "#\\a is U+0061"
-        (eqv? #x61 (char->integer #\a)))
-(pass-if "#\\A is U+0041"
+ (pass-if "#\\a is U+0061"
+         (eqv? #x61 (char->integer #\a)))
+ (pass-if "#\\A is U+0041"
         (eqv? #x41 (char->integer #\A)))
-(pass-if "#\\( is U+0028"
-        (eqv? #x28 (char->integer #\()))
-
-
-;; Named characters
-;; R6RS named characters are case-sensitive
-(pass-if "#\\nul is U+0000"
-        (eqv? #x00 (char->integer #\nul)))
-
-(pass-if "#\\alarm is U+0007"
-        (eqv? #x07 (char->integer #\alarm)))
-
-(pass-if "#\\backspace is U+0008"
-        (eqv? #x08 (char->integer #\backspace)))
-
-(pass-if "#\\tab is U+0009"
-        (eqv? #x09 (char->integer #\tab)))
-
-(pass-if "#\\linefeed is U+000A"
-        (eqv? #x0A (char->integer #\linefeed)))
-
-(pass-if "#\\vtab is U+000B"
-        (eqv? #x0B (char->integer #\vtab)))
-
-(pass-if "#\\page is U+000C"
-        (eqv? #x0C (char->integer #\page)))
-
-(pass-if "#\\return is U+000D"
-        (eqv? #x0D (char->integer #\return)))
-
-(pass-if "#\\esc is U+001B"
-        (eqv? #x1B (char->integer #\esc)))
-
-(pass-if "#\\space is U+0020"
-        (eqv? #x20 (char->integer #\space)))
-
-(pass-if "#\\delete is U+007F"
-        (eqv? #x7F (char->integer #\delete)))
-
-(pass-if-exception "non-existent named character #\\foobar" 
exception:read-error
-                  (with-input-from-string "#\\foobar" read))
-
-(pass-if-exception "R6RS character names are case sensitive" 
exception:read-error
-                  (with-input-from-string "#\\Alarm" read))
-
-(pass-if-exception "character names match entire token" exception:read-error
-                  (with-input-from-string "#\\alarmz" read))
-
-;; R6RS hex escapes
-(pass-if "#\\xFF is U+00FF"
-        (eqv? #xFF (char->integer #\xFF)))
-
-(pass-if "#\\x03BB is U+03BB"
-        (eqv? #x03BB (char->integer #\x03BB)))
-
-(pass-if "#\\x00006587 is U+6587"
-        (eqv? #x6587 (char->integer #\x00006587)))
-
-(pass-if-exception "#\\x0001z is exception" exception:read-error
-                  (with-input-from-string "#\\x0001z" read))
-
-(pass-if "'#\\alarm x' is U+0007 followed by x"
-        (let ((x #\a))
-          (eqv? (string-ref (string #\alarm x) 0)
-                #\x07)))
-
-(pass-if "#\\xff is U+00FF"
-        (eqv? #xff (char->integer #\xff)))
-
-(pass-if "'#\\x ff' is U+0078 followed by the datum 'ff'"
-        (let ((ff #\a))
-          (eqv? (string-ref (string #\x ff) 0)
-                #\x)))
-
-(pass-if-exception "#\\x00110000 is exception" exception:read-error
-                  (with-input-from-string "#\\x00110000" read))
-
-(pass-if "#\\x000000001 is U+0001"
-        (eqv? #x01 (char->integer #\x000000001)))
-
-(pass-if-exception "#\\xD800 is exception" exception:read-error
-        (with-input-from-string "#\\xD800" read))
-
-;; Deprecated but still legal R6RS handling
-(pass-if "#\\  is U+0020"
-        (eqv? #x20 (char->integer #\ )))
-(pass-if "#\\newline is U+000A"
-        (eqv? #x0A (char->integer #\newline)))
-
-;; R6RS non-ASCII character names
-;; Greek lambda encoded in UTF-8 in source file
-;;(pass-if "#\\λ is U+03BB"
-;;      (eqv? #x03BB (char->integer #\λ)))
-
+ (pass-if "#\\( is U+0028"
+         (eqv? #x28 (char->integer #\())))
 
 ;;;;;;;;;;
 ;; R5RS character handling
 
 ;; Named characters
 ;; R5RS named characters are case-insensitive
-(pass-if "#\\space is U+0020"
-        (eqv? #x20 (char->integer #\space)))
-(pass-if "#\\SPACE is U+0020"
-        (eqv? #x20 (char->integer #\SPACE)))
-(pass-if "#\\newline is U+000A"
-        (eqv? #x0A (char->integer #\newline)))
-(pass-if "#\\NEWLINE is U+000A"
-        (eqv? #x0A (char->integer #\NEWLINE)))
-                            
-
-;;;;;;;;;;
-;; Non-RnRS Guile extensions
-
-;; C0 and C1 control names
-;; So far, these have not been treated as case sensitive.
-(pass-if "C0 control names"
-        (list= eqv? 
-               (list 
-                #\nul #\soh #\stx #\etx #\eot #\enq #\ack #\bel
-                #\bs  #\ht  #\lf  #\vt  #\ff  #\cr  #\so  #\si
-                #\dle #\dc1 #\dc2 #\dc3 #\dc4 #\nak #\syn #\etb
-                #\can #\em  #\sub #\esc #\fs  #\gs  #\rs  #\us
-                #\sp #\del)
-               (list
-                #\x00 #\x01 #\x02 #\x03 #\x04 #\x05 #\x06 #\x07
-                #\x08 #\x09 #\x0A #\x0B #\x0C #\x0D #\x0E #\x0F
-                #\x10 #\x11 #\x12 #\x13 #\x14 #\x15 #\x16 #\x17
-                #\x18 #\x19 #\x1A #\x1B #\x1C #\x1D #\x1E #\x1F
-                #\x20 #\x7F)))
-
-(pass-if "C1 control names"
-        (list= eqv?
-               (list
-                #\bph #\nbh #\ind #\nel #\ssa #\esa
-                #\hts #\htj #\vts #\pld #\plu #\ri  #\ss2 #\ss3
-                #\dcs #\pu1 #\pu2 #\sts #\cch #\mw  #\spa #\epa
-                #\sos #\sci #\csi #\st  #\osc #\pm  #\apc
-                #\nbsp #\shy)
-               (list
-                #\x82 #\x83 #\x84 #\x85 #\x86 #\x87
-                #\x88 #\x89 #\x8A #\x8B #\x8C #\x8D #\x8E #\x8F
-                #\x90 #\x91 #\x92 #\x93 #\x94 #\x95 #\x96 #\x97
-                #\x98 #\x9A #\x9B #\x9C #\x9D #\x9E #\x9F
-                #\xA0 #\xAD)))
-
-;; Octal character escapes
-(pass-if "octal character escapes"
-        (list= (eqv?
-                (list #\000 #\010 #\020 #\030)
-                (list #\x00 #\x08 #\x10 #\x18)))))
-                
-
+(with-test-prefix "Character names"
+  (pass-if "#\\space is U+0020"
+          (eqv? #x20 (char->integer #\space)))
+  (pass-if "#\\SPACE is U+0020"
+          (eqv? #x20 (char->integer #\SPACE)))
+  (pass-if "#\\newline is U+000A"
+          (eqv? #x0A (char->integer #\newline)))
+  (pass-if "#\\NEWLINE is U+000A"
+          (eqv? #x0A (char->integer #\NEWLINE)))
+
+  (pass-if "C0 controls"
+          (list= eqv? 
+                 (list 
+                  #\nul #\soh #\stx #\etx #\eot #\enq #\ack #\bel
+                  #\bs  #\ht  #\lf  #\vt  #\ff  #\cr  #\so  #\si
+                  #\dle #\dc1 #\dc2 #\dc3 #\dc4 #\nak #\syn #\etb
+                  #\can #\em  #\sub #\esc #\fs  #\gs  #\rs  #\us
+                  #\sp #\del)
+                 (list
+                  #\000 #\001 #\002 #\003 #\004 #\005 #\006 #\007
+                  #\010 #\011 #\012 #\013 #\014 #\015 #\016 #\017
+                  #\020 #\021 #\022 #\023 #\024 #\025 #\026 #\027
+                  #\030 #\031 #\032 #\033 #\034 #\035 #\036 #\037
+                  #\040 #\177))))
 ;;;;;;;;;;
 ;; Write format of characters
 
@@ -212,83 +93,5 @@
           (str (with-output-to-string (lambda () (write lst)))))
       (list= eqv? 
             lst
-            (with-input-from-string str read))))
-
-  (pass-if "ISO-8859-1 characters"
-    (let* ((lst (map integer->char (iota 128 128)))
-          (str (with-output-to-string (lambda () (write lst)))))
-      (list= eqv? 
-            lst
             (with-input-from-string str read)))))
 
-;;;;;;;;;;
-;; Basic character functions
-(with-test-prefix "R6RS character procedures"
-
-(pass-if "char? #\\a is true"
-        (eq? #t (char? #\a)))
-(pass-if "char? #f is false"
-        (eq? #f (char? #f)))
-(pass-if "char->integer #\\a returns U+0061"
-        (= (char->integer #\a) #x61))
-(pass-if "integer->char 0"
-        (eq? #\nul (integer->char 0)))
-(pass-if "integer->char #xD7FF"
-        (eq? #\xd7ff (integer->char #xd7ff)))
-(pass-if "integer->char #xE000"
-        (eq? #\xe000 (integer->char #xe000)))
-(pass-if "integer->char #x10FFFF"
-        (eq? #\x10ffff (integer->char #x10ffff)))
-(pass-if-exception "integer->char -1 should fail" exception:out-of-range
-                  (integer->char -1))
-(pass-if-exception "integer->char #xd800 should fail" exception:out-of-range
-                  (integer->char #xd800))
-(pass-if-exception "integer->char #xdfff should fail" exception:out-of-range
-                  (integer->char #xdfff))
-(pass-if-exception "integer->char #x1a0000 should fail" exception:out-of-range
-                  (integer->char #x1a0000))
-
-(pass-if "char=? a a a"
-        (eq? #t (char=? #\a #\a #\a)))
-(pass-if "char=? space a a-grave"
-        (eq? #f (char=? #\space #\a #\xe0)))
-(pass-if "char=? a-grave a space"
-        (eq? #f (char=? #\xe0 #\a #\space)))
-
-(pass-if "char<? a a a"
-        (eq? #f (char<? #\a #\a #\a)))
-(pass-if "char<? space a a-grave"
-        (eq? #t (char<? #\space #\a #\xe0)))
-(pass-if "char<? a-grave a space"
-        (eq? #f (char<? #\xe0 #\a #\space)))
-
-(pass-if "char>? a a a"
-        (eq? #f (char>? #\a #\a #\a)))
-(pass-if "char>? space a a-grave"
-        (eq? #f (char>? #\space #\a #\xe0)))
-(pass-if "char>? a-grave a space"
-        (eq? #t (char>? #\xe0 #\a #\space)))
-
-(pass-if "char<=? a a a"
-        (eq? #t (char<=? #\a #\a #\a)))
-(pass-if "char<=? space a a-grave"
-        (eq? #t (char<=? #\space #\a #\xe0)))
-(pass-if "char<=? a-grave a space"
-        (eq? #f (char<=? #\xe0 #\a #\space)))
-
-(pass-if "char>=? a a a"
-        (eq? #t (char>=? #\a #\a #\a)))
-(pass-if "char>=? space a a-grave"
-        (eq? #f (char>=? #\space #\a #\xe0)))
-(pass-if "char>=? a-grave a space"
-        (eq? #t (char>=? #\xe0 #\a #\space)))
-
-
-(pass-if "char-is-both? works"
-        (and
-         (not (char-is-both? #\?))
-         (not (char-is-both? #\newline))
-         (char-is-both? #\a)
-         (char-is-both? #\Z)
-         (not (char-is-both? #\1)))))
-
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 91f09dd..0b6f9a4 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -34,7 +34,7 @@
 (define exception:eof-in-string
   (cons 'read-error "end of file in string constant$"))
 (define exception:illegal-escape
-  (cons 'read-error "invalid character in escape sequence: .*$"))
+  (cons 'read-error "illegal character in escape sequence: .*$"))
 
 
 (define (read-string s)
@@ -88,7 +88,7 @@
 
   (pass-if "CR recognized as a token delimiter"
     ;; In 1.8.3, character 0x0d was not recognized as a delimiter.
-    (equal? (read-string "one\x0d;two") 'one))
+    (equal? (read-string "one\x0dtwo") 'one))
 
   (pass-if "returned strings are mutable"
     ;; Per R5RS Section 3.4, "Storage Model", `read' is supposed to return
@@ -165,6 +165,11 @@
          (with-read-options '(keywords postfix)
            (lambda ()
              (read-string "keyword:")))))
+  (pass-if "long postfix keywords"
+    (eq? 
#:keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789
+         (with-read-options '(keywords postfix)
+           (lambda ()
+             (read-string 
"keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789:")))))
   (pass-if "`:' is not a postfix keyword (per SRFI-88)"
     (eq? ':
          (with-read-options '(keywords postfix)
diff --git a/test-suite/tests/strings-r6rs.test 
b/test-suite/tests/strings-r6rs.test
new file mode 100644
index 0000000..0bb15e0
--- /dev/null
+++ b/test-suite/tests/strings-r6rs.test
@@ -0,0 +1,203 @@
+;;;; strings.test --- test suite for Guile's string functions    -*- scheme -*-
+;;;; Jim Blandy <address@hidden> --- August 1999
+;;;;
+;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008, 2009 Free Software 
Foundation, Inc.
+;;;; 
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2, or (at your option)
+;;;; any later version.
+;;;; 
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this software; see the file COPYING.  If not, write to
+;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
+
+(define-module (test-strings)
+  #:use-module (test-suite lib)
+  #:use-module (srfi srfi-1))
+
+(read-enable 'r6rs-escapes)
+
+(define exception:read-only-string
+  (cons 'misc-error "^string is read-only"))
+(define exception:read-error
+  (cons 'read-error "^.*"))
+
+;; Create a string from integer char values, eg. (string-ints 65) => "A"
+(define (string-ints . args)
+  (apply string (map integer->char args)))
+
+
+;;
+;; String escapes
+;;
+
+(with-test-prefix "string escapes"
+
+  (pass-if "alarm"
+    (eqv? (string-ref "\a" 0)
+         #\alarm))
+
+  (pass-if "backspace"
+    (eqv? (string-ref "\b" 0)
+         #\backspace))
+
+  (pass-if "tab"
+    (eqv? (string-ref "\t" 0)
+         #\tab))
+
+  (pass-if "linefeed"
+    (eqv? (string-ref "\n" 0)
+         #\linefeed))
+
+  (pass-if "vtab"
+    (eqv? (string-ref "\v" 0)
+         #\vtab))
+
+  (pass-if "return"
+    (eqv? (string-ref "\r" 0)
+         #\return))
+
+  (pass-if "doublequote"
+    (eqv? (string-ref "\"" 0)
+         #\" ))
+
+  (pass-if "backslash"
+    (eqv? (string-ref "\\" 0)
+         #\\ ))
+
+  (pass-if "line-ending slash"
+    (string=?
+     "abc\
+d"
+     "abcd"))
+
+  (pass-if "1 digit valid hex escape"
+    (read-enable 'r6rs-escapes)
+    (let ((ret (string=? "\x9;a" "\ta")))
+      (read-disable 'r6rs-escapes)))
+  
+  (pass-if "2 digit valid hex escape"
+    (string=? "\x41;B" "AB"))
+
+  (pass-if "3 digit valid hex escape"
+    (string=? "\x100;B"
+            (string #\x100 #\B)))
+
+  (pass-if-exception "invalid escape \\+" exception:read-error
+    (with-input-from-string "\"\\+\"" read))
+
+  (pass-if-exception "hex escape \\x-1; is invalid" exception:read-error
+    (with-input-from-string "\"\\x-1;\"" read))
+
+  (pass-if-exception "hex escape \\xd800; is invalid" 
+    exception:read-error
+    (with-input-from-string "\"\\xd800;\"" read))
+
+  (pass-if-exception "hex escape \\xdfff; is invalid" 
+    exception:read-error
+    (with-input-from-string "\"\\xdfff;\"" read))
+
+  (pass-if-exception "hex escape \\x1a0000; is invalid" 
+    exception:read-error
+    (with-input-from-string "\"\\x1a0000;\"" read))
+
+  (pass-if "'abc' is #\\x61 #\\x62 #\\x63"
+    (string=? "abc" (string #\x61 #\x62 #\x63)))
+
+  (pass-if "'\\x41;bc' is 'Abc'"
+    (string=? "\x41;bc" "Abc"))
+
+  (pass-if "'\\x41; bc' is 'A bc'"
+    (string=? "\x41; bc" "A bc"))
+
+  (pass-if "'\\x41bc;' is #\\x41bc"
+    (string=? "\x41bc;" (string #\x41bc)))
+
+  (pass-if-exception "'\\x41' is missing semicolon at EOF" exception:read-error
+    (with-input-from-string "\"\\x41\"" read))
+
+  (pass-if-exception "'\\x;' is invalid" exception:read-error
+    (with-input-from-string "\"\\x;\"" read))
+
+  (pass-if "'\\x00000041;' is 'A'"
+    (string=? "\x00000041;" "A"))
+
+  (pass-if "'\\x0010FFFF;' is #\\x10FFFF"
+    (string=? "\x0010FFFF;" (string #\x10FFFF))))
+
+;;
+;; Write format
+;;
+
+(with-test-prefix "string write format"
+
+  (pass-if "C0 control characters: block 1"
+    (string=? 
"\"\\0\\x1;\\x2;\\x3;\\x4;\\x5;\\x6;\\a\\b\\t\\n\\v\\f\\r\\xe;\\xf;\""
+             (with-output-to-string 
+               (lambda ()
+                 (write (apply string (map integer->char (iota 16))))))))
+
+  (pass-if "C0 control characters: block 2"
+    (string=? 
"\"\\x10;\\x11;\\x12;\\x13;\\x14;\\x15;\\x16;\\x17;\\x18;\\x19;\\x1a;\\x1b;\\x1c;\\x1d;\\x1e;\\x1f;\""
+             (with-output-to-string 
+               (lambda ()
+                 (write (apply string (map integer->char (iota 16 16))))))))
+
+  (pass-if "ASCII chars: block 3"
+    (string=? "\" !\\\"#$%&'()*+,-./\""
+             (with-output-to-string
+               (lambda ()
+                 (write (apply string (map integer->char (iota 16 32))))))))
+
+  (pass-if "ASCII chars: block 4"
+    (string=? "\"0123456789:;<=>?\""
+             (with-output-to-string
+               (lambda ()
+                 (write (apply string (map integer->char (iota 16 48))))))))
+
+  (pass-if "ASCII chars: block 5"
+    (string=? "\"@ABCDEFGHIJKLMNO\""
+             (with-output-to-string
+               (lambda ()
+                 (write (apply string (map integer->char (iota 16 64))))))))
+
+  (pass-if "ASCII chars: block 6"
+    (string=? "\"PQRSTUVWXYZ[\\\\]^_\""
+             (with-output-to-string
+               (lambda ()
+                 (write (apply string (map integer->char (iota 16 80))))))))
+
+  (pass-if "ASCII chars: block 7"
+    (string=? "\"`abcdefghijklmno\""
+             (with-output-to-string
+               (lambda ()
+                 (write (apply string (map integer->char (iota 16 96))))))))
+
+  (pass-if "ASCII chars: block 8"
+    (string=? "\"pqrstuvwxyz{|}~\\x7f;\""
+             (with-output-to-string
+               (lambda ()
+                 (write (apply string (map integer->char (iota 16 112))))))))
+
+  (pass-if "Reversibility"
+    (let* ((str (apply string (map integer->char (iota #xFF))))
+          (istr (with-output-to-string
+                  (lambda()
+                    (write str))))
+          (ostr (with-input-from-string istr read)))
+      ;; (display istr) (newline)
+      ;; (write ostr) (newline)
+      (force-output)
+      (string=? str ostr))))
+
+
+
+
+
diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test
index 9686418..51f1632 100644
--- a/test-suite/tests/strings.test
+++ b/test-suite/tests/strings.test
@@ -1,7 +1,7 @@
 ;;;; strings.test --- test suite for Guile's string functions    -*- scheme -*-
 ;;;; Jim Blandy <address@hidden> --- August 1999
 ;;;;
-;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008, 2009 Free Software 
Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008 Free Software 
Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -19,14 +19,11 @@
 ;;;; Boston, MA 02110-1301 USA
 
 (define-module (test-strings)
-  #:use-module (test-suite lib)
-  #:use-module (srfi srfi-1))
+  #:use-module (test-suite lib))
 
 
 (define exception:read-only-string
   (cons 'misc-error "^string is read-only"))
-(define exception:read-error
-  (cons 'read-error "^.*"))
 
 ;; Create a string from integer char values, eg. (string-ints 65) => "A"
 (define (string-ints . args)
@@ -260,169 +257,3 @@
       (string-upcase! (substring/shared str2 1 4))
       (and (string=? str1 "foofoofoo")
           (string=? str2 "oFOOf")))))
-
-;;
-;; String escapes
-;;
-
-(with-test-prefix "string escapes"
-
-  (pass-if "alarm"
-    (eqv? (string-ref "\a" 0)
-         #\alarm))
-
-  (pass-if "backspace"
-    (eqv? (string-ref "\b" 0)
-         #\backspace))
-
-  (pass-if "tab"
-    (eqv? (string-ref "\t" 0)
-         #\tab))
-
-  (pass-if "linefeed"
-    (eqv? (string-ref "\n" 0)
-         #\linefeed))
-
-  (pass-if "vtab"
-    (eqv? (string-ref "\v" 0)
-         #\vtab))
-
-  (pass-if "return"
-    (eqv? (string-ref "\r" 0)
-         #\return))
-
-  (pass-if "doublequote"
-    (eqv? (string-ref "\"" 0)
-         #\" ))
-
-  (pass-if "backslash"
-    (eqv? (string-ref "\\" 0)
-         #\\ ))
-
-  (pass-if "line-ending slash"
-    (string=?
-     "abc\
-d"
-     "abcd"))
-
-  (pass-if "1 digit valid hex escape"
-    (string=? "\x9;a" "\ta"))
-  
-  (pass-if "2 digit valid hex escape"
-    (string=? "\x41;B" "AB"))
-
-  (pass-if "3 digit valid hex escape"
-    (string=? "\x100;B"
-            (string #\x100 #\B)))
-
-  (pass-if-exception "invalid escape \\+" exception:read-error
-    (with-input-from-string "\"\\+\"" read))
-
-  (pass-if-exception "hex escape \\x-1; is invalid" exception:read-error
-    (with-input-from-string "\"\\x-1;\"" read))
-
-  (pass-if-exception "hex escape \\xd800; is invalid" 
-    exception:read-error
-    (with-input-from-string "\"\\xd800;\"" read))
-
-  (pass-if-exception "hex escape \\xdfff; is invalid" 
-    exception:read-error
-    (with-input-from-string "\"\\xdfff;\"" read))
-
-  (pass-if-exception "hex escape \\x1a0000; is invalid" 
-    exception:read-error
-    (with-input-from-string "\"\\x1a0000;\"" read))
-
-  (pass-if "'abc' is #\\x61 #\\x62 #\\x63"
-    (string=? "abc" (string #\x61 #\x62 #\x63)))
-
-  (pass-if "'\\x41;bc' is 'Abc'"
-    (string=? "\x41;bc" "Abc"))
-
-  (pass-if "'\\x41; bc' is 'A bc'"
-    (string=? "\x41; bc" "A bc"))
-
-  (pass-if "'\\x41bc;' is #\\x41bc"
-    (string=? "\x41bc;" (string #\x41bc)))
-
-  (pass-if-exception "'\\x41' is missing semicolon at EOF" exception:read-error
-    (with-input-from-string "\"\\x41\"" read))
-
-  (pass-if-exception "'\\x;' is invalid" exception:read-error
-    (with-input-from-string "\"\\x;\"" read))
-
-  (pass-if "'\\x00000041;' is 'A'"
-    (string=? "\x00000041;" "A"))
-
-  (pass-if "'\\x0010FFFF;' is #\\x10FFFF"
-    (string=? "\x0010FFFF;" (string #\x10FFFF))))
-
-;;
-;; Write format
-;;
-
-(with-test-prefix "string write format"
-
-  (pass-if "C0 control characters: block 1"
-    (string=? 
"\"\\0\\x1;\\x2;\\x3;\\x4;\\x5;\\x6;\\a\\b\\t\\n\\v\\f\\r\\xe;\\xf;\""
-             (with-output-to-string 
-               (lambda ()
-                 (write (apply string (map integer->char (iota 16))))))))
-
-  (pass-if "C0 control characters: block 2"
-    (string=? 
"\"\\x10;\\x11;\\x12;\\x13;\\x14;\\x15;\\x16;\\x17;\\x18;\\x19;\\x1a;\\x1b;\\x1c;\\x1d;\\x1e;\\x1f;\""
-             (with-output-to-string 
-               (lambda ()
-                 (write (apply string (map integer->char (iota 16 16))))))))
-
-  (pass-if "ASCII chars: block 3"
-    (string=? "\" !\\\"#$%&'()*+,-./\""
-             (with-output-to-string
-               (lambda ()
-                 (write (apply string (map integer->char (iota 16 32))))))))
-
-  (pass-if "ASCII chars: block 4"
-    (string=? "\"0123456789:;<=>?\""
-             (with-output-to-string
-               (lambda ()
-                 (write (apply string (map integer->char (iota 16 48))))))))
-
-  (pass-if "ASCII chars: block 5"
-    (string=? "\"@ABCDEFGHIJKLMNO\""
-             (with-output-to-string
-               (lambda ()
-                 (write (apply string (map integer->char (iota 16 64))))))))
-
-  (pass-if "ASCII chars: block 6"
-    (string=? "\"PQRSTUVWXYZ[\\\\]^_\""
-             (with-output-to-string
-               (lambda ()
-                 (write (apply string (map integer->char (iota 16 80))))))))
-
-  (pass-if "ASCII chars: block 7"
-    (string=? "\"`abcdefghijklmno\""
-             (with-output-to-string
-               (lambda ()
-                 (write (apply string (map integer->char (iota 16 96))))))))
-
-  (pass-if "ASCII chars: block 8"
-    (string=? "\"pqrstuvwxyz{|}~\\x7f;\""
-             (with-output-to-string
-               (lambda ()
-                 (write (apply string (map integer->char (iota 16 112))))))))
-
-  (pass-if "Reversibility"
-    (let* ((str (apply string (map integer->char (iota #xFF))))
-          (istr (with-output-to-string
-                  (lambda()
-                    (write str))))
-          (ostr (with-input-from-string istr read)))
-      ;; (display istr) (newline)
-      ;; (write ostr) (newline)
-      (force-output)
-      (string=? str ostr))))
-
-
-
-
-


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]