/* Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2003, 2004, 2006,
- * 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+ * 2007, 2008, 2009, 2010, 2011, 2012, 2014 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
return SCM_UNSPECIFIED;
}
+/* If the EXPECTED_CHARS are the next ones available from PORT, then
+ consume them and return 1. Otherwise leave the port position where
+ it was and return 0. EXPECTED_CHARS should be all lowercase, and
+ will be matched case-insensitively against the characters read from
+ PORT. */
+static int
+try_read_ci_chars (SCM port, const char *expected_chars)
+{
+ int num_chars_wanted = strlen (expected_chars);
+ int num_chars_read = 0;
+ char *chars_read = alloca (num_chars_wanted);
+ int c;
+
+ while (num_chars_read < num_chars_wanted)
+ {
+ c = scm_getc (port);
+ if (c == EOF)
+ break;
+ else if (tolower (c) != expected_chars[num_chars_read])
+ {
+ scm_ungetc (c, port);
+ break;
+ }
+ else
+ chars_read[num_chars_read++] = c;
+ }
+
+ if (num_chars_read == num_chars_wanted)
+ return 1;
+ else
+ {
+ while (num_chars_read > 0)
+ scm_ungetc (chars_read[--num_chars_read], port);
+ return 0;
+ }
+}
+
\f
/* Sharp readers, i.e. readers called after a `#' sign has been read. */
{
case 't':
case 'T':
+ try_read_ci_chars (port, "rue");
return SCM_BOOL_T;
case 'f':
case 'F':
+ try_read_ci_chars (port, "alse");
return SCM_BOOL_F;
}
c = scm_getc (port);
if (c != '3' && c != '6')
{
- if (c != EOF)
- scm_ungetc (c, port);
+ if (c == 'a' && try_read_ci_chars (port, "lse"))
+ return SCM_BOOL_F;
+ else if (c != EOF)
+ scm_ungetc (c, port);
return SCM_BOOL_F;
}
rank = 1;
;;;; reader.test --- Reader test. -*- coding: iso-8859-1; mode: scheme -*-
;;;;
-;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008, 2009, 2010, 2011,
+;;;; 2014 Free Software Foundation, Inc.
;;;; Jim Blandy <jimb@red-bean.com>
;;;;
;;;; This library is free software; you can redistribute it and/or
(not (equal? (imag-part (read-string "-nan.0-1i"))
(imag-part (read-string "-nan.0+1i")))))
+ (pass-if-equal "#true"
+ '(a #t b)
+ (read-string "(a #true b)"))
+
+ (pass-if-equal "#false"
+ '(a #f b)
+ (read-string "(a #false b)"))
+
;; At one time the arg list for "Unknown # object: ~S" didn't make it out
;; of read.c. Check that `format' can be applied to this error.
(pass-if "error message on bad #"