Merge branch 'stable-2.0'

Conflicts:
	libguile/chars.c
	libguile/read.c
	test-suite/tests/reader.test

7 files changed, 109 insertions, 18 deletions

diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 59d7db075..1a3d2e873 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -56,6 +56,7 @@ For the documentation of such @dfn{compound} data types, see
 @tpindex Booleans
 
 The two boolean values are @code{#t} for true and @code{#f} for false.
+They can also be written as @code{#true} and @code{#false}, as per R7RS.
 
 Boolean values are returned by predicate procedures, such as the general
 equality predicates @code{eq?}, @code{eqv?} and @code{equal?}
@@ -2065,6 +2066,9 @@ name for each character.
 The short name for the ``delete'' character (code point U+007F) is
 @code{#\del}.
 
+The R7RS name for the ``escape'' character (code point U+001B) is
+@code{#\escape}.
+
 There are also a few alternative names left over for compatibility with
 previous versions of Guile.
 
@@ -2937,9 +2941,10 @@ The read syntax for strings is an arbitrarily long sequence of
 characters enclosed in double quotes (@nicode{"}).
 
 Backslash is an escape character and can be used to insert the following
-special characters.  @nicode{\"} and @nicode{\\} are R5RS standard, the
-next seven are R6RS standard --- notice they follow C syntax --- and the
-remaining four are Guile extensions.
+special characters.  @nicode{\"} and @nicode{\\} are R5RS standard,
+@nicode{\|} is R7RS standard, the next seven are R6RS standard ---
+notice they follow C syntax --- and the remaining four are Guile
+extensions.
 
 @table @asis
 @item @nicode{\\}
@@ -2949,6 +2954,9 @@ Backslash character.
 Double quote character (an unescaped @nicode{"} is otherwise the end
 of the string).
 
+@item @nicode{\|}
+Vertical bar character.
+
 @item @nicode{\a}
 Bell character (ASCII 7).
 
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 32ff271b7..3b73c083e 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -1,7 +1,7 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013
-@c   Free Software Foundation, Inc.
+@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008,
+@c   2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
 @node SRFI Support
@@ -149,7 +149,9 @@ srfi-4
 srfi-6
 srfi-13
 srfi-14
+srfi-16
 srfi-23
+srfi-30
 srfi-39
 srfi-55
 srfi-61
diff --git a/libguile/chars.c b/libguile/chars.c
index fbedb0fe2..9f50c1e25 100644
--- a/libguile/chars.c
+++ b/libguile/chars.c
@@ -1,5 +1,6 @@
-/*	Copyright (C) 1995,1996,1998, 2000, 2001, 2004, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
- * 
+/* Copyright (C) 1995,1996,1998, 2000, 2001, 2004, 2006, 2008, 2009,
+ *   2010, 2011, 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
  * as published by the Free Software Foundation; either version 3 of
@@ -554,6 +555,16 @@ static const scm_t_uint32 const scm_r6rs_charnums[] = {
 
 #define SCM_N_R6RS_CHARNAMES (sizeof (scm_r6rs_charnames) / sizeof (char *))
 
+static const char *const scm_r7rs_charnames[] = {
+  "escape"
+};
+
+static const scm_t_uint32 const scm_r7rs_charnums[] = {
+  0x1b
+};
+
+#define SCM_N_R7RS_CHARNAMES (sizeof (scm_r7rs_charnames) / sizeof (char *))
+
 /* The abbreviated names for control characters.  */
 static const char *const scm_C0_control_charnames[] = {
   /* C0 controls */
@@ -600,6 +611,10 @@ scm_i_charname (SCM chr)
     if (scm_r6rs_charnums[c] == i)
       return scm_r6rs_charnames[c];
 
+  for (c = 0; c < SCM_N_R7RS_CHARNAMES; c++)
+    if (scm_r7rs_charnums[c] == i)
+      return scm_r7rs_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];
@@ -625,13 +640,20 @@ scm_i_charname_to_char (const char *charname, size_t charname_len)
 	&& (!strncasecmp (scm_r5rs_charnames[c], charname, charname_len)))
       return SCM_MAKE_CHAR (scm_r5rs_charnums[c]);
 
-  /* The R6RS charnames.  R6RS says that these should be case-sensitive.  They
-     are left as case-insensitive to avoid confusion.  */
+  /* The R6RS charnames.  R6RS says that these should be case-sensitive.
+     They are left as case-insensitive to avoid confusion.  */
   for (c = 0; c < SCM_N_R6RS_CHARNAMES; c++)
     if ((strlen (scm_r6rs_charnames[c]) == charname_len)
 	&& (!strncasecmp (scm_r6rs_charnames[c], charname, charname_len)))
       return SCM_MAKE_CHAR (scm_r6rs_charnums[c]);
 
+  /* The R7RS charnames.  R7RS says that these should be case-sensitive.
+     They are left as case-insensitive to avoid confusion.  */
+  for (c = 0; c < SCM_N_R7RS_CHARNAMES; c++)
+    if ((strlen (scm_r7rs_charnames[c]) == charname_len)
+	&& (!strncasecmp (scm_r7rs_charnames[c], charname, charname_len)))
+      return SCM_MAKE_CHAR (scm_r7rs_charnums[c]);
+
   /* Then come the controls.  By Guile convention, these are not case
      sensitive.  */
   for (c = 0; c < SCM_N_C0_CONTROL_CHARNAMES; c++)
diff --git a/libguile/read.c b/libguile/read.c
index 61addf3a5..b3e6eebb4 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -1,5 +1,5 @@
 /* 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
@@ -30,6 +30,7 @@
 #include <unicase.h>
 #include <unictype.h>
 #include <c-strcase.h>
+#include <c-ctype.h>
 
 #include "libguile/_scm.h"
 #include "libguile/bytevectors.h"
@@ -624,6 +625,7 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
             case EOF:
               goto str_eof;
             case '"':
+            case '|':
             case '\\':
               break;
             case '\n':
@@ -941,6 +943,43 @@ scm_read_semicolon_comment (int chr, SCM port)
   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_unlocked (port);
+      if (c == EOF)
+        break;
+      else if (c_tolower (c) != expected_chars[num_chars_read])
+        {
+          scm_ungetc_unlocked (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_unlocked (chars_read[--num_chars_read], port);
+      return 0;
+    }
+}
+
 
 /* Sharp readers, i.e. readers called after a `#' sign has been read.  */
 
@@ -951,10 +990,12 @@ scm_read_boolean (int chr, SCM port)
     {
     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;
     }
 
@@ -1155,8 +1196,10 @@ scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column)
       c = scm_getc_unlocked (port);
       if (c != '3' && c != '6')
 	{
-	  if (c != EOF)
-	    scm_ungetc_unlocked (c, port);
+          if (c == 'a' && try_read_ci_chars (port, "lse"))
+            return SCM_BOOL_F;
+          else if (c != EOF)
+            scm_ungetc_unlocked (c, port);
 	  return SCM_BOOL_F;
 	}
       rank = 1;
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 3748c1336..bb4cf1fce 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1,7 +1,7 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 
 ;;;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;;;;   2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013
+;;;;   2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014
 ;;;;   Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -4214,7 +4214,9 @@ when none is available, reading FILE-NAME with READER."
     srfi-6   ;; string ports
     srfi-13  ;; string library
     srfi-14  ;; character sets
+    srfi-16  ;; case-lambda
     srfi-23  ;; `error` procedure
+    srfi-30  ;; nested multi-line comments
     srfi-39  ;; parameterize
     srfi-55  ;; require-extension
     srfi-61  ;; general cond clause
diff --git a/module/srfi/srfi-16.scm b/module/srfi/srfi-16.scm
index caec784ba..d103ce979 100644
--- a/module/srfi/srfi-16.scm
+++ b/module/srfi/srfi-16.scm
@@ -1,6 +1,6 @@
 ;;; srfi-16.scm --- case-lambda
 
-;; Copyright (C) 2001, 2002, 2006, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2006, 2009, 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
@@ -48,6 +48,4 @@
 (define-module (srfi srfi-16)
   #:re-export (case-lambda))
 
-;; Case-lambda is now provided by code psyntax.
-
-(cond-expand-provide (current-module) '(srfi-16))
+;; Case-lambda is now provided by core psyntax.
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index e1fe22dad..9f30b4bff 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -1,7 +1,7 @@
 ;;;; reader.test --- Reader test.    -*- coding: iso-8859-1; mode: scheme -*-
 ;;;;
 ;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008, 2009, 2010, 2011,
-;;;;   2013 Free Software Foundation, Inc.
+;;;;   2013, 2014 Free Software Foundation, Inc.
 ;;;; Jim Blandy <jimb@red-bean.com>
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -73,6 +73,22 @@
     (not (equal? (imag-part (read-string "-nan.0-1i"))
                  (imag-part (read-string "-nan.0+1i")))))
 
+  (pass-if-equal "'\|' in string literals"
+      "a|b"
+    (read-string "\"a\\|b\""))
+
+  (pass-if-equal "#\\escape"
+      '(a #\esc b)
+    (read-string "(a #\\escape b)"))
+
+  (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 #"