[Guile-commits] GNU Guile branch, master, updated. v2.1.0-615-gba578eb

[Mark H Weaver]

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=ba578eb04460833c5acb1d8f4c08d2facde15e80

The branch, master has been updated
       via  ba578eb04460833c5acb1d8f4c08d2facde15e80 (commit)
       via  611563fb05c18ca52f780746e9963ca9735e9bac (commit)
       via  d278daca688148f4d1a270e984b054b8ea23cc8a (commit)
       via  3ff8a9d6ff9c8b9f3be7c03b624b3042bb61079f (commit)
       via  802a25b1ed5c738aa5f9d3d01f33eb89b22afd1b (commit)
       via  6df03222128887bf9982631183ab1cf6c144fe42 (commit)
       via  2d6a3144a122982d5b6a9365943f73891bdb87d3 (commit)
       via  da81e75d3e65445fa56865a28f83b07391853a0a (commit)
      from  a9eca8f5d1bb2a3aabb80b59c54fc355a00a0382 (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 ba578eb04460833c5acb1d8f4c08d2facde15e80
Merge: a9eca8f 611563f
Author: Mark H Weaver <address@hidden>
Date:   Tue Jan 21 03:57:04 2014 -0500

    Merge branch 'stable-2.0'
    
    Conflicts:
        libguile/read.c
        test-suite/tests/web-response.test

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

Summary of changes:
 THANKS                             |    1 +
 doc/ref/api-macros.texi            |    6 +++---
 doc/ref/libguile-linking.texi      |   17 ++++++++++-------
 doc/ref/srfi-modules.texi          |   21 +++++++++++++++++++++
 libguile/r6rs-ports.c              |   10 +++++++---
 libguile/read.c                    |   32 ++++++++++++++++++++++++--------
 module/ice-9/boot-9.scm            |    2 ++
 module/web/response.scm            |   27 ++++++++++++++++-----------
 test-suite/tests/coding.test       |   10 ++++++++--
 test-suite/tests/r6rs-ports.test   |    9 +++++++++
 test-suite/tests/syntax.test       |   17 +++++++++++++++--
 test-suite/tests/web-response.test |    6 ++++--
 12 files changed, 120 insertions(+), 38 deletions(-)

diff --git a/THANKS b/THANKS
index 90a4357..f16376b 100644
--- a/THANKS
+++ b/THANKS
@@ -168,6 +168,7 @@ For fixes or providing information which led to a fix:
          Rainer Tammer
         Samuel Thibault
         Richard Todd
+    Sree Harsha Totakura
             Tom Tromey
           Issac Trotts
            Greg Troxel
diff --git a/doc/ref/api-macros.texi b/doc/ref/api-macros.texi
index d4dbd8f..799a1c9 100644
--- a/doc/ref/api-macros.texi
+++ b/doc/ref/api-macros.texi
@@ -1,7 +1,7 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 
2010, 2011, 2012, 2013
address@hidden   Free Software Foundation, Inc.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 
2010, 2011,
address@hidden   2012, 2013, 2014 Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
 @node Macros
@@ -393,7 +393,7 @@ templates.  For example:
 When writing macros that generate macro definitions, it is convenient to
 use a different ellipsis identifier at each level.  Guile allows the
 desired ellipsis identifier to be specified as the first operand to
address@hidden, as per R7RS.  For example:
address@hidden, as specified by SRFI-46 and R7RS.  For example:
 
 @example
 (define-syntax define-quotation-macros
diff --git a/doc/ref/libguile-linking.texi b/doc/ref/libguile-linking.texi
index de90768..433f3b3 100644
--- a/doc/ref/libguile-linking.texi
+++ b/doc/ref/libguile-linking.texi
@@ -71,24 +71,23 @@ Here is @file{simple-guile.c}, source code for a 
@code{main} and an
 interpreter.
 
 @example
-/* simple-guile.c --- how to start up the Guile
-   interpreter from C code.  */
+/* simple-guile.c --- Start Guile from C.  */
 
-/* Get declarations for all the scm_ functions.  */
 #include <libguile.h>
 
 static void
 inner_main (void *closure, int argc, char **argv)
 @{
-  /* module initializations would go here */
+  /* preparation */
   scm_shell (argc, argv);
+  /* after exit */
 @}
 
 int
 main (int argc, char **argv)
 @{
   scm_boot_guile (argc, argv, inner_main, 0);
-  return 0; /* never reached */
+  return 0; /* never reached, see inner_main */
 @}
 @end example
 
@@ -97,7 +96,9 @@ Guile, passing it @code{inner_main}.  Once 
@code{scm_boot_guile} is
 ready, it invokes @code{inner_main}, which calls @code{scm_shell} to
 process the command-line arguments in the usual way.
 
-Here is a Makefile which you can use to compile the above program.  It
address@hidden Building the Example with Make
+
+Here is a Makefile which you can use to compile the example program.  It
 uses @code{pkg-config} to learn about the necessary compiler and
 linker flags.
 @example
@@ -117,8 +118,10 @@ simple-guile.o: simple-guile.c
         address@hidden@} -c address@hidden@} simple-guile.c
 @end example
 
address@hidden Building the Example with Autoconf
+
 If you are using the GNU Autoconf package to make your application more
-portable, Autoconf will settle many of the details in the Makefile above
+portable, Autoconf will settle many of the details in the Makefile
 automatically, making it much simpler and more portable; we recommend
 using Autoconf with Guile.  Here is a @file{configure.ac} file for
 @code{simple-guile} that uses the standard @code{PKG_CHECK_MODULES}
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 0eb20d9..84cc164 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -48,12 +48,14 @@ get the relevant SRFI documents from the SRFI home page
 * SRFI-41::                     Streams.
 * SRFI-42::                     Eager comprehensions
 * SRFI-45::                     Primitives for expressing iterative lazy 
algorithms
+* SRFI-46::                     Basic syntax-rules Extensions.
 * SRFI-55::                     Requiring Features.
 * SRFI-60::                     Integers as bits.
 * SRFI-61::                     A more general `cond' clause
 * SRFI-62::                     S-expression comments.
 * SRFI-67::                     Compare procedures
 * SRFI-69::                     Basic hash tables.
+* SRFI-87::                     => in case clauses.
 * SRFI-88::                     Keyword objects.
 * SRFI-98::                     Accessing environment variables.
 * SRFI-105::                    Curly-infix expressions.
@@ -154,9 +156,11 @@ srfi-16
 srfi-23
 srfi-30
 srfi-39
+srfi-46
 srfi-55
 srfi-61
 srfi-62
+srfi-87
 srfi-105
 @end example
 
@@ -4649,6 +4653,15 @@ apply @code{force} to arguments of deconstructors (e.g., 
@code{car},
 wrap procedure bodies with @code{(lazy ...)}.
 @end itemize
 
address@hidden SRFI-46
address@hidden SRFI-46 Basic syntax-rules Extensions
address@hidden SRFI-46
+
+Guile's core @code{syntax-rules} supports the extensions specified by
+SRFI-46/R7RS.  Tail patterns have been supported since at least Guile
+2.0, and custom ellipsis identifiers have been supported since Guile
+2.0.10.  @xref{Syntax Rules}.
+
 @node SRFI-55
 @subsection SRFI-55 - Requiring Features
 @cindex SRFI-55
@@ -5033,6 +5046,14 @@ Answer a hash value appropriate for equality predicate 
@code{equal?},
 @code{hash} is a backwards-compatible replacement for Guile's built-in
 @code{hash}.
 
address@hidden SRFI-87
address@hidden SRFI-87 => in case clauses
address@hidden SRFI-87
+
+Starting from version 2.0.6, Guile's core @code{case} syntax supports
address@hidden>} in clauses, as specified by SRFI-87/R7RS.
address@hidden
+
 @node SRFI-88
 @subsection SRFI-88 Keyword Objects
 @cindex SRFI-88
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index fc67689..a8fc3f1 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -334,9 +334,11 @@ cbip_fill_input (SCM port)
   if (c_port->read_pos >= c_port->read_end)
     {
       /* Invoke the user's `read!' procedure.  */
-      unsigned c_octets;
+      size_t c_octets, c_requested;
       SCM bv, read_proc, octets;
 
+      c_requested = c_port->read_buf_size;
+
       /* Use the bytevector associated with PORT as the buffer passed to the
         `read!' procedure, thereby avoiding additional allocations.  */
       bv = SCM_CBIP_BYTEVECTOR (port);
@@ -350,8 +352,10 @@ cbip_fill_input (SCM port)
              == SCM_BYTEVECTOR_LENGTH (bv));
 
       octets = scm_call_3 (read_proc, bv, SCM_INUM0,
-                          SCM_I_MAKINUM (CBIP_BUFFER_SIZE));
-      c_octets = scm_to_uint (octets);
+                          scm_from_size_t (c_requested));
+      c_octets = scm_to_size_t (octets);
+      if (SCM_UNLIKELY (c_octets > c_requested))
+       scm_out_of_range (FUNC_NAME, octets);
 
       c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
       c_port->read_end = (unsigned char *) c_port->read_pos + c_octets;
diff --git a/libguile/read.c b/libguile/read.c
index 980769b..bcb40ee 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -2022,8 +2022,6 @@ scm_get_hash_procedure (int c)
     }
 }
 
-#define SCM_ENCODING_SEARCH_SIZE (500)
-
 static int
 is_encoding_char (char c)
 {
@@ -2033,9 +2031,20 @@ is_encoding_char (char c)
   return strchr ("_-.:/,+=()", c) != NULL;
 }
 
-/* Search the first few hundred characters of a file for an Emacs-like coding
-   declaration.  Returns either NULL or a string whose storage has been
-   allocated with `scm_gc_malloc ()'.  */
+/* Maximum size of an encoding name.  This is a bit more than the
+   longest name listed at
+   <http://www.iana.org/assignments/character-sets> ("ISO-2022-JP-2", 13
+   characters.)  */
+#define ENCODING_NAME_MAX_SIZE 20
+
+/* Number of bytes at the beginning or end of a file that are scanned
+   for a "coding:" declaration.  */
+#define SCM_ENCODING_SEARCH_SIZE (500 + ENCODING_NAME_MAX_SIZE)
+
+
+/* Search the SCM_ENCODING_SEARCH_SIZE bytes of a file for an Emacs-like
+   coding declaration.  Returns either NULL or a string whose storage
+   has been allocated with `scm_gc_malloc'.  */
 char *
 scm_i_scan_for_encoding (SCM port)
 {
@@ -2094,8 +2103,8 @@ scm_i_scan_for_encoding (SCM port)
       if ((pos = strstr(pos, "coding")) == NULL)
         return NULL;
 
-      pos += strlen("coding");
-      if (pos - header >= SCM_ENCODING_SEARCH_SIZE || 
+      pos += strlen ("coding");
+      if (pos - header >= SCM_ENCODING_SEARCH_SIZE ||
           (*pos == ':' || *pos == '='))
         {
           pos ++;
@@ -2104,10 +2113,17 @@ scm_i_scan_for_encoding (SCM port)
     }
 
   /* skip spaces */
-  while (pos - header <= SCM_ENCODING_SEARCH_SIZE && 
+  while (pos - header <= SCM_ENCODING_SEARCH_SIZE &&
         (*pos == ' ' || *pos == '\t'))
     pos ++;
 
+  if (pos - header >= SCM_ENCODING_SEARCH_SIZE - ENCODING_NAME_MAX_SIZE)
+    /* We found the "coding:" string, but there is probably not enough
+       room to store an encoding name in its entirety, so ignore it.
+       This makes sure we do not end up returning a truncated encoding
+       name.  */
+    return NULL;
+
   /* grab the next token */
   encoding_start = pos;
   i = 0;
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 5b52299..cac058c 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -4218,9 +4218,11 @@ when none is available, reading FILE-NAME with READER."
     srfi-23  ;; `error` procedure
     srfi-30  ;; nested multi-line comments
     srfi-39  ;; parameterize
+    srfi-46  ;; basic syntax-rules extensions
     srfi-55  ;; require-extension
     srfi-61  ;; general cond clause
     srfi-62  ;; s-expression comments
+    srfi-87  ;; => in case clauses
     srfi-105 ;; curly infix expressions
     ))
 
diff --git a/module/web/response.scm b/module/web/response.scm
index 570a2d7..58e3f11 100644
--- a/module/web/response.scm
+++ b/module/web/response.scm
@@ -1,6 +1,6 @@
 ;;; HTTP response objects
 
-;; Copyright (C)  2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2012, 2013, 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
@@ -246,16 +246,21 @@ closes PORT, unless KEEP-ALIVE? is true."
                   bytes-read len))
 
   (define (read! bv start count)
-    (let ((ret (get-bytevector-n! port bv start count)))
-      (if (eof-object? ret)
-          (if (= bytes-read len)
-              0
-              (fail))
-          (begin
-            (set! bytes-read (+ bytes-read ret))
-            (if (> bytes-read len)
-                (fail)
-                ret)))))
+    ;; Read at most LEN bytes in total.  HTTP/1.1 doesn't say what to do
+    ;; when a server provides more than the Content-Length, but it seems
+    ;; wise to just stop reading at LEN.
+    (let ((count (min count (- len bytes-read))))
+      (let loop ((ret (get-bytevector-n! port bv start count)))
+        (cond ((eof-object? ret)
+               (if (= bytes-read len)
+                   0                              ; EOF
+                   (fail)))
+              ((and (zero? ret) (> count 0))
+               ;; Do not return zero since zero means EOF, so try again.
+               (loop (get-bytevector-n! port bv start count)))
+              (else
+               (set! bytes-read (+ bytes-read ret))
+               ret)))))
 
   (define close
     (and (not keep-alive?)
diff --git a/test-suite/tests/coding.test b/test-suite/tests/coding.test
index a8a415f..b57ef7d 100644
--- a/test-suite/tests/coding.test
+++ b/test-suite/tests/coding.test
@@ -1,6 +1,6 @@
 ;;;; coding.test --- test suite for coding declarations. -*- mode: scheme -*-
 ;;;;
-;;;; Copyright (C) 2011, 2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 2011, 2013, 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
@@ -101,4 +101,10 @@
 
   (pass-if-equal "second line, whitespace, nl"
       "ISO-8859-1"
-    (scan-coding "\n; coding: iso-8859-1 \n")))
+    (scan-coding "\n; coding: iso-8859-1 \n"))
+
+  (pass-if-equal "http://bugs.gnu.org/16463";
+      ;; On Guile <= 2.0.9, this would return "ISO-8".
+      "ISO-8859-1"
+    (scan-coding (string-append (make-string 485 #\space)
+                                "; coding: ISO-8859-1"))))
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index abd5d6f..4bd8a70 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -411,6 +411,15 @@
       (not (or (port-has-port-position? port)
                (port-has-set-port-position!? port)))))
 
+  (pass-if-exception "custom binary input port 'read!' returns too much"
+      exception:out-of-range
+    ;; In Guile <= 2.0.9 this would segfault.
+    (let* ((read! (lambda (bv start count)
+                    (+ count 4242)))
+           (port (make-custom-binary-input-port "the port" read!
+                                                #f #f #f)))
+      (get-bytevector-all port)))
+
   (pass-if-equal "custom binary input port supports `port-position', \
 not `set-port-position!'"
       42
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index 4bde635..d88e791 100644
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -1,7 +1,7 @@
 ;;;; syntax.test --- test suite for Guile's syntactic forms    -*- scheme -*-
 ;;;;
 ;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2009, 2010,
-;;;;   2011, 2012, 2013 Free Software Foundation, Inc.
+;;;;   2011, 2012, 2013, 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
@@ -1275,7 +1275,20 @@
               '((((x y) …) ...)
                 (((x y) ...) …)))))))
       (define-syntax bar (foo x y z))
-      (bar a b c))))
+      (bar a b c)))
+
+  ;; This test is given in SRFI-46.
+  (pass-if-equal "custom ellipsis is handled hygienically"
+      '((1) 2 (3) (4))
+    (let-syntax
+        ((f (syntax-rules ()
+              ((f ?e)
+               (let-syntax
+                   ((g (syntax-rules --- ()
+                         ((g (??x ?e) (??y ---))
+                          '((??x) ?e (??y) ---)))))
+                 (g (1 2) (3 4)))))))
+      (f ---))))
 
 (with-test-prefix "syntax-error"
 
diff --git a/test-suite/tests/web-response.test 
b/test-suite/tests/web-response.test
index 4f88aa6..3c1894e 100644
--- a/test-suite/tests/web-response.test
+++ b/test-suite/tests/web-response.test
@@ -1,6 +1,6 @@
 ;;;; web-response.test --- HTTP responses       -*- mode: scheme; coding: 
utf-8; -*-
 ;;;;
-;;;;   Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2010, 2011, 2012, 2013, 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
@@ -39,7 +39,9 @@ Content-Encoding: gzip\r
 Content-Length: 36\r
 Content-Type: text/html; charset=utf-8\r
 \r
-abcdefghijklmnopqrstuvwxyz0123456789")
+abcdefghijklmnopqrstuvwxyz0123456789
+-> Here is trailing garbage that should be ignored because it is
+   beyond Content-Length.")
 
 (define example-2
   "HTTP/1.1 200 OK\r


hooks/post-receive
-- 
GNU Guile