guile-commits
[Top][All Lists]
Advanced

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

[Guile-commits] GNU Guile branch, lloda-array-support, updated. v2.1.0-1


From: Daniel Llorens
Subject: [Guile-commits] GNU Guile branch, lloda-array-support, updated. v2.1.0-152-g0f25904
Date: Tue, 30 Sep 2014 09:35:27 +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=0f259045e16ee48ae8c9bcccbe45297ddd90d4a8

The branch, lloda-array-support has been updated
  discards  04913f6078e9ef1d29e29d481812b7499e7a6d69 (commit)
  discards  4594ba8f14f45512488db32974fdb3cf0344e470 (commit)
  discards  1850011dcca72ea4a1855ae6ef027321cfd201e3 (commit)
       via  0f259045e16ee48ae8c9bcccbe45297ddd90d4a8 (commit)
       via  65704b982dcc9758d5e5a5452832a43a1ec453d6 (commit)
       via  ea342aa6f7fd4a03dc0cc4bde8e6746c1daf083e (commit)
       via  856d318a9f543d8a61fcf61caae7d07102586802 (commit)
       via  3157d455039f137ca5dfa8b9fbc4a3404ce00606 (commit)
       via  7a71a45cfd6092402d540e9bc5d2432941a8a336 (commit)
       via  ff4af3df238815e434b62693a3c02b8213667ebe (commit)
       via  447af515a3ca2525974efa12fea8513223540403 (commit)
       via  3a3316e200ac49f0e8e9004c233747efd9f54a04 (commit)
       via  76a8db27c65b59879a8c27363f374035b233d6b7 (commit)
       via  8442211ef0029581b35f784489afcf210491fc41 (commit)
       via  f2742bdd68619323da2c5f9f65f10684f6522e3c (commit)
       via  0fce815b1b50bc80092acfea44d03e4739140478 (commit)
       via  8f230e3341c344afe891cc45d0370c42a7813ace (commit)
       via  97c520fd3ff5ae0305b6d236e0bc31f794a6cce6 (commit)
       via  bed025bd2569b1c033f24d7d9e660e39ebf65cac (commit)
       via  156119b0223cf14d335ebda84701a69b2ba95757 (commit)
       via  a85c78ea1393985fdb6e6678dea19135c553d341 (commit)
       via  b38c19a5a5935dc5b874625767ed4951452f46c2 (commit)
       via  9233c05585c908b6e1612001eda51cf9c0324d91 (commit)
       via  8ac39b38d14f47b6028030fa829f1fe7d0499f21 (commit)
       via  c6a7930b38a55aa2402f4ed722a4ef460ad67810 (commit)
       via  cfefef6bd96294b373104e85d80bc3f4f3fb482b (commit)
       via  7c848fe5724666edf667e753b5c828c21748fe31 (commit)
       via  1e9249e0cd0814937cb4bdda84c3002e24adbcb2 (commit)
       via  da6ecd4923a8c5422e695604b2e06733a7ae074e (commit)
       via  b072b8e6924bb1a05ffb66bcbde30b375df5443f (commit)
       via  8857e271d810623868509f837d17613195f6528c (commit)
       via  ffd3e55cfd12a3559621e3130d613d319243512d (commit)
       via  d40752513fff3306bed31e40721e627720b2f8ff (commit)
       via  f184e887a6cb09a97cf34feab30eeba4a28a3ae4 (commit)
       via  8c75d3ae01ed98ccb623bdff1c25cc17c046145c (commit)
       via  df8c52e93dfa3965e4714275f4b8cea2c8e0170b (commit)
       via  c53b5d891fb8369abcb7fb3f8d00e134ab7b2d9b (commit)
       via  8c6b62e7d5bbc5bfe0c69110156a80539f97b978 (commit)
       via  9235f805fa0bacc02a6ddaeceb9867cb37d01d85 (commit)
       via  9dc3fc4dd474ce4da6a45dcf197e1f99a9a7047a (commit)
       via  5102fc3790a781af8fc124cc6f1e6a1fd990ceb9 (commit)
       via  317f6a237089a421d8cb57f398eedf6afc600832 (commit)
       via  bc945fadd2e94c5ddf1a5b42e7eef5726b5b1068 (commit)
       via  4698a11cbdb057953cf4e02126c701d875cc1f42 (commit)
       via  0d77e062dc70ed10cfcedf1e6080287f8be20b1b (commit)
       via  c7161ee334c20a81cb50512b2d6ae0aebf34ede9 (commit)
       via  f0893308461d9586d4fd00d78fd7999a660058ff (commit)
       via  700f6cd86b939789e19fd325f3ad2862eac5975e (commit)
       via  c84f25bccebb1ba557ace597370d88bc8f5382e6 (commit)
       via  82b8cfa40cbaea1ef2b8053af574c6d84f2705bc (commit)
       via  43191a31a5f15729acbde3fa58f750021977a9f9 (commit)
       via  d86a0631585ba887cd8635001f3a2c8d000c6517 (commit)
       via  fc8a90043bb8dc876cf638d9959348883c748fe3 (commit)
       via  4afca1a0662323ed8760c75d84c3aadc64b72908 (commit)
       via  1ea8954814d124b995f2296bc6aec92adb566bc1 (commit)
       via  2da97f1c7c0748509180308d9e6a817bc49172e7 (commit)
       via  a5186f506f69ef8a8accd234ca434efd13f302c9 (commit)
       via  12c6a47773041ff5d0a3553421d2f358d9e479a9 (commit)
       via  a43fa1b70688b09a9eecac3c2ce8e9adea63bab6 (commit)
       via  a41b07a34f7309dccb2140ed924d7cd1c63268f9 (commit)
       via  eb6ac6efcdb6fe72fdecb4aa7161e86d0e1d3282 (commit)
       via  1baa2159307c34683e8ede54f38f65010fc594b0 (commit)
       via  0bb3f946e97424616c1a95f2372e5bc41e8f8174 (commit)
       via  c497bfb1f6e58c118aa35087104ab821dca5030c (commit)
       via  5e793ad8517d4036b115d2dbaaf105aad0414a20 (commit)

This update added new revisions after undoing existing revisions.  That is
to say, the old revision is not a strict subset of the new revision.  This
situation occurs when you --force push a change and generate a repository
containing something like this:

 * -- * -- B -- O -- O -- O (04913f6078e9ef1d29e29d481812b7499e7a6d69)
            \
             N -- N -- N (0f259045e16ee48ae8c9bcccbe45297ddd90d4a8)

When this happens we assume that you've already had alert emails for all
of the O revisions, and so we here report only the revisions in the N
branch from the common base, B.

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 0f259045e16ee48ae8c9bcccbe45297ddd90d4a8
Author: Daniel Llorens <address@hidden>
Date:   Fri Sep 19 14:48:59 2014 +0200

    Intern general arrays
    
    * module/system/vm/assembler.scm (intern-constant, link-data): handle
      the array case.

commit 65704b982dcc9758d5e5a5452832a43a1ec453d6
Author: Daniel Llorens <address@hidden>
Date:   Fri Sep 19 14:48:22 2014 +0200

    Pack array dimensions in array object
    
    * libguile/arrays.c (scm_i_make_array): redo object layout.
    
    * libguile/arrays.h (SCM_I_ARRAY_V, SCM_ARRAY_BASE, SCM_I_ARRAY_DIMS):
      to match new layout.
    
      (SCM_I_ARRAY_SET_V, SCM_ARRAY_SET_BASE): new setters.
    
      (SCM_I_ARRAY_MEM, scm_i_t_array): unused, remove.
    
      (scm_i_shap2ra, scm_make_typed_array, scm_from_contiguous_typed_array,
      scm_from_contiguous_array, scm_make_shared_array, scm_transpose_array,
      scm_array_contents): fix uses of SCM_I_ARRAY_V, SCM_ARRAY_BASE as
      lvalues.
    
    * libguile/array-map.c (make1array, scm_ramapc): fix uses of
      SCM_I_ARRAY_V, SCM_ARRAY_BASE as lvalues.

commit ea342aa6f7fd4a03dc0cc4bde8e6746c1daf083e
Author: Daniel Llorens <address@hidden>
Date:   Fri Sep 19 14:47:40 2014 +0200

    Run some of arrays.test under both compiler & interpreter
    
    * test-suite/test-suite/lib.scm (c&e): accept (pass-if exp) clause.
    
    * test-suite/tests/arrays.test: use with-prefix/c&e instead of
      with-prefix where possible.

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

Summary of changes:
 THANKS                                   |    2 +
 autogen.sh                               |    6 +-
 benchmark-suite/benchmarks/ports.bm      |    9 +-
 configure.ac                             |   15 +-
 doc/ref/api-evaluation.texi              |    5 +-
 doc/ref/api-modules.texi                 |   41 ++-
 doc/ref/api-utility.texi                 |    2 +-
 doc/ref/posix.texi                       |   10 +-
 doc/ref/srfi-modules.texi                |   14 +-
 doc/ref/texinfo.texi                     |    2 +-
 guile-readline/ice-9/readline.scm        |    3 +-
 libguile/async.h                         |   11 +-
 libguile/bytevectors.c                   |   16 +-
 libguile/debug.c                         |   17 +-
 libguile/filesys.c                       |    4 +
 libguile/foreign.c                       |    2 +-
 libguile/fports.c                        |    2 +-
 libguile/gsubr.c                         |    3 +-
 libguile/i18n.c                          |   51 ++-
 libguile/init.c                          |    3 +
 libguile/list.c                          |   31 +-
 libguile/load.c                          |   60 +++-
 libguile/load.h                          |    1 +
 libguile/locale-categories.h             |    8 +-
 libguile/posix.c                         |   22 +-
 libguile/simpos.c                        |   32 ++-
 libguile/smob.h                          |   10 +-
 libguile/srfi-1.c                        |   40 ++-
 libguile/threads.c                       |    7 +
 module/Makefile.am                       |   17 +-
 module/ice-9/boot-9.scm                  |   14 +-
 module/ice-9/curried-definitions.scm     |   13 +-
 module/ice-9/rdelim.scm                  |   44 ++-
 module/language/tree-il/analyze.scm      |   12 +-
 module/language/tree-il/peval.scm        |   29 ++-
 module/scripts/compile.scm               |   10 +-
 module/srfi/srfi-43.scm                  |   18 +-
 module/system/base/target.scm            |   12 +-
 module/web/client.scm                    |    4 +-
 test-suite/standalone/Makefile.am        |    6 +-
 test-suite/standalone/test-guild-compile |   42 +++
 test-suite/test-suite/lib.scm            |   14 +
 test-suite/tests/c-api.test              |    5 +-
 test-suite/tests/coding.test             |    5 +-
 test-suite/tests/cross-compilation.test  |   10 +-
 test-suite/tests/i18n.test               |   45 ++-
 test-suite/tests/modules.test            |    5 +-
 test-suite/tests/peval.test              |   86 +++++-
 test-suite/tests/popen.test              |    9 +-
 test-suite/tests/ports.test              |  562 ++++++++++++++++--------------
 test-suite/tests/posix.test              |    7 +-
 test-suite/tests/r6rs-files.test         |   14 +-
 test-suite/tests/r6rs-ports.test         |   20 +
 test-suite/tests/rdelim.test             |   10 +-
 test-suite/tests/srfi-1.test             |    6 +-
 test-suite/tests/threads.test            |   13 +-
 test-suite/tests/tree-il.test            |   50 +++-
 57 files changed, 1019 insertions(+), 492 deletions(-)
 create mode 100755 test-suite/standalone/test-guild-compile

diff --git a/THANKS b/THANKS
index d34b951..4038d5e 100644
--- a/THANKS
+++ b/THANKS
@@ -167,6 +167,7 @@ For fixes or providing information which led to a fix:
           Cesar Strauss
          Klaus Stehle
          Rainer Tammer
+          Frank Terbeck
         Samuel Thibault
         Richard Todd
     Sree Harsha Totakura
@@ -182,6 +183,7 @@ For fixes or providing information which led to a fix:
           Aaron VanDevender
          Sjoerd Van Leent
        Andreas Vögele
+          Chris Vine
         Michael Talbot-Wilson
         Michael Tuexen
             Xin Wang
diff --git a/autogen.sh b/autogen.sh
index 5187cd4..af1ade60 100755
--- a/autogen.sh
+++ b/autogen.sh
@@ -15,11 +15,7 @@ autoconf --version
 echo ""
 automake --version
 echo ""
-if test "`uname -s`" = Darwin; then
-  glibtool --version
-else
-  libtool --version
-fi
+libtoolize --version
 echo ""
 ${M4:-m4} --version
 echo ""
diff --git a/benchmark-suite/benchmarks/ports.bm 
b/benchmark-suite/benchmarks/ports.bm
index 0b1d7f5..4177255 100644
--- a/benchmark-suite/benchmarks/ports.bm
+++ b/benchmark-suite/benchmarks/ports.bm
@@ -1,6 +1,6 @@
 ;;; ports.bm --- Port I/O.         -*- mode: scheme; coding: utf-8; -*-
 ;;;
-;;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public License
@@ -87,4 +87,9 @@
   (let ((str (string-concatenate (make-list 1000 "one line\n"))))
     (benchmark "read-line" 1000
                (let ((port (open-input-string str)))
-                 (sequence (read-line port) 1000)))))
+                 (sequence (read-line port) 1000))))
+
+  (let ((str (large-string "Hello, world.\n")))
+    (benchmark "read-string" 200
+               (let ((port (open-input-string str)))
+                 (read-string port)))))
diff --git a/configure.ac b/configure.ac
index 55bfafc..1524601 100644
--- a/configure.ac
+++ b/configure.ac
@@ -692,10 +692,9 @@ AC_TYPE_GETGROUPS
 AC_TYPE_SIGNAL
 AC_TYPE_MODE_T
 
-# On mingw -lm is empty, so this test is unnecessary, but it's
-# harmless so we don't hard-code to suppress it.
-#
-AC_CHECK_LIB(m, cos)
+dnl Check whether we need -lm.
+LT_LIB_M
+LIBS="$LIBS $LIBM"
 
 AC_CHECK_FUNCS(gethostbyname)
 if test $ac_cv_func_gethostbyname = no; then
@@ -770,9 +769,6 @@ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 
ctermid             \
   strcoll strcoll_l newlocale utimensat sched_getaffinity              \
   sched_setaffinity sendfile])
 
-AM_CONDITIONAL([BUILD_ICE_9_POPEN],
-  [test "x$enable_posix" = "xyes" && test "x$ac_cv_func_fork" = "xyes"])
-
 # Reasons for testing:
 #   netdb.h - not in mingw
 #   sys/param.h - not in mingw
@@ -1351,8 +1347,11 @@ case "$with_threads" in
     #     pthread_attr_get_np - "np" meaning "non portable" says it
     #         all; specific to FreeBSD
     #     pthread_sigmask - not available on mingw
+    #     pthread_cancel - not available on Android (Bionic libc)
     #
-    AC_CHECK_FUNCS(pthread_attr_getstack pthread_getattr_np 
pthread_get_stackaddr_np pthread_attr_get_np pthread_sigmask)
+    AC_CHECK_FUNCS([pthread_attr_getstack pthread_getattr_np           \
+      pthread_get_stackaddr_np pthread_attr_get_np pthread_sigmask     \
+      pthread_cancel])
 
     # On past versions of Solaris, believe 8 through 10 at least, you
     # had to write "pthread_once_t foo = { PTHREAD_ONCE_INIT };".
diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index a23cf1a..296f1da 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -215,8 +215,9 @@ convention is used when indenting code in Emacs' Scheme 
mode.
 In addition to the standard line comments defined by R5RS, Guile has
 another comment type for multiline comments, called @dfn{block
 comments}.  This type of comment begins with the character sequence
address@hidden and ends with the characters @code{!#}, which must appear on a
-line of their own.  These comments are compatible with the block
address@hidden and ends with the characters @code{!#}.
+
+These comments are compatible with the block
 comments in the Scheme Shell @file{scsh} (@pxref{The Scheme shell
 (scsh)}).  The characters @code{#!} were chosen because they are the
 magic characters used in shell scripts for indicating that the name of
diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi
index 286a37d..e9d7aec 100644
--- a/doc/ref/api-modules.texi
+++ b/doc/ref/api-modules.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 
2008, 2009, 2010, 2011, 2012, 2013
address@hidden Copyright (C)  1996, 1997, 2000-2004, 2007-2014
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -126,6 +126,16 @@ them to suit the current module's needs.  For example:
               #:renamer (symbol-prefix-proc 'unixy:)))
 @end lisp
 
address@hidden
+or more simply:
+
address@hidden prefix
address@hidden
+(use-modules ((ice-9 popen)
+              #:select ((open-pipe . pipe-open) close-pipe)
+              #:prefix unixy:))
address@hidden lisp
+
 Here, the interface specification is more complex than before, and the
 result is that a custom interface with only two bindings is created and
 subsequently accessed by the current module.  The mapping of old to new
@@ -184,21 +194,24 @@ whose public interface is found and used.
 
 @cindex binding renamer
 @lisp
- (MODULE-NAME [#:select SELECTION] [#:renamer RENAMER])
+ (MODULE-NAME [#:select SELECTION]
+              [#:prefix PREFIX]
+              [#:renamer RENAMER])
 @end lisp
 
 in which case a custom interface is newly created and used.
 @var{module-name} is a list of symbols, as above; @var{selection} is a
-list of selection-specs; and @var{renamer} is a procedure that takes a
-symbol and returns its new name.  A selection-spec is either a symbol or
-a pair of symbols @code{(ORIG . SEEN)}, where @var{orig} is the name in
-the used module and @var{seen} is the name in the using module.  Note
-that @var{seen} is also passed through @var{renamer}.
-
-The @code{#:select} and @code{#:renamer} clauses are optional.  If both are
-omitted, the returned interface has no bindings.  If the @code{#:select}
-clause is omitted, @var{renamer} operates on the used module's public
-interface.
+list of selection-specs; @var{prefix} is a symbol that is prepended to
+imported names; and @var{renamer} is a procedure that takes a symbol and
+returns its new name.  A selection-spec is either a symbol or a pair of
+symbols @code{(ORIG . SEEN)}, where @var{orig} is the name in the used
+module and @var{seen} is the name in the using module.  Note that
address@hidden is also modified by @var{prefix} and @var{renamer}.
+
+The @code{#:select}, @code{#:prefix}, and @code{#:renamer} clauses are
+optional.  If all are omitted, the returned interface has no bindings.
+If the @code{#:select} clause is omitted, @var{prefix} and @var{renamer}
+operate on the used module's public interface.
 
 In addition to the above, @var{spec} can also include a @code{#:version} 
 clause, of the form:
@@ -584,8 +597,8 @@ expression:
 
 @lisp
   (library (mylib (1 2))
-    (import (otherlib (3)))
-    (export mybinding))
+    (export mybinding)
+    (import (otherlib (3))))
 @end lisp
 
 is equivalent to the module definition:
diff --git a/doc/ref/api-utility.texi b/doc/ref/api-utility.texi
index ffdf276..e2b60e2 100644
--- a/doc/ref/api-utility.texi
+++ b/doc/ref/api-utility.texi
@@ -222,7 +222,7 @@ setting of @var{obj}'s @var{property}.
 
 A single object property created by @code{make-object-property} can
 associate distinct property values with all Scheme values that are
-distinguishable by @code{eq?} (including, for example, integers).
+distinguishable by @code{eq?} (ruling out numeric values).
 
 Internally, object properties are implemented using a weak key hash
 table.  This means that, as long as a Scheme value with property values
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 570102c..9182bd8 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1793,13 +1793,19 @@ Example: (system* "echo" "foo" "bar")
 Terminate the current process with proper unwinding of the Scheme stack.
 The exit status zero if @var{status} is not supplied.  If @var{status}
 is supplied, and it is an integer, that integer is used as the exit
-status.  If @var{status} is @code{#t} or @code{#f}, the exit status is 0
-or 1, respectively.
+status.  If @var{status} is @code{#t} or @code{#f}, the exit status is
address@hidden or @var{EXIT_FAILURE}, respectively.
 
 The procedure @code{exit} is an alias of @code{quit}.  They have the
 same functionality.
 @end deffn
 
address@hidden {Scheme Variable} EXIT_SUCCESS
address@hidden {Scheme Variable} EXIT_FAILURE
+These constants represent the standard exit codes for success (zero) or
+failure (one.)
address@hidden defvr
+
 @deffn {Scheme Procedure} primitive-exit [status]
 @deffnx {Scheme Procedure} primitive-_exit [status]
 @deffnx {C Function} scm_primitive_exit (status)
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 882b7d3..4ebf76d 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.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 
2007, 2008,
address@hidden   2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, 
Inc.
address@hidden Copyright (C) 1996, 1997, 2000-2004, 2006, 2007-2014
address@hidden   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
 @node SRFI Support
@@ -4517,11 +4517,11 @@ Create and return a vector whose elements are @var{x} 
@enddots{}.
 @end deffn
 
 @deffn {Scheme Procedure} vector-unfold f length initial-seed @dots{}
-The fundamental vector constructor.  Create a vector whose length is
address@hidden and iterates across each index k from 0 up to
address@hidden - 1, applying @var{f} at each iteration to the current index
-and current seeds, in that order, to receive n + 1 values: first, the
-element to put in the kth slot of the new vector and n new seeds for
+The fundamental vector constructor.  Create a vector whose length
+is @var{length} and iterates across each index k from 0 up to
address@hidden - 1, applying @var{f} at each iteration to the current
+index and current seeds, in that order, to receive n + 1 values: the
+element to put in the kth slot of the new vector, and n new seeds for
 the next iteration.  It is an error for the number of seeds to vary
 between iterations.
 
diff --git a/doc/ref/texinfo.texi b/doc/ref/texinfo.texi
index ec06863..5006fd4 100644
--- a/doc/ref/texinfo.texi
+++ b/doc/ref/texinfo.texi
@@ -287,7 +287,7 @@ as an argument, and the returned value is sent to the 
output string via
 @samp{display}. If @var{replace} is anything else, it is sent through
 the output string via @samp{display}.
 
-Note that te replacement for the matched characters does not need to be
+Note that the replacement for the matched characters does not need to be
 a single character. That is what differentiates this function from
 @samp{string-map}, and what makes it useful for applications such as
 converting @samp{#\&} to @samp{"&amp;"} in web page text. Some other
diff --git a/guile-readline/ice-9/readline.scm 
b/guile-readline/ice-9/readline.scm
index 02e68af..df2edaf 100644
--- a/guile-readline/ice-9/readline.scm
+++ b/guile-readline/ice-9/readline.scm
@@ -119,7 +119,8 @@
 (define-once the-readline-port #f)
 
 (define-once history-variable "GUILE_HISTORY")
-(define-once history-file (string-append (getenv "HOME") "/.guile_history"))
+(define-once history-file
+  (string-append (or (getenv "HOME") ".") "/.guile_history"))
 
 (define-public readline-port
   (let ((do (lambda (r/w)
diff --git a/libguile/async.h b/libguile/async.h
index e6fe523..00b7914 100644
--- a/libguile/async.h
+++ b/libguile/async.h
@@ -3,7 +3,8 @@
 #ifndef SCM_ASYNC_H
 #define SCM_ASYNC_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2005, 2006, 2008, 
2009, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2008, 2009, 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
@@ -44,10 +45,10 @@ SCM_API SCM scm_run_asyncs (SCM list_of_a);
 SCM_API SCM scm_noop (SCM args);
 SCM_API SCM scm_call_with_blocked_asyncs (SCM proc);
 SCM_API SCM scm_call_with_unblocked_asyncs (SCM proc);
-void *scm_c_call_with_blocked_asyncs (void *(*p) (void *d), void *d);
-void *scm_c_call_with_unblocked_asyncs (void *(*p) (void *d), void *d);
-void scm_dynwind_block_asyncs (void);
-void scm_dynwind_unblock_asyncs (void);
+SCM_API void *scm_c_call_with_blocked_asyncs (void *(*p) (void *d), void *d);
+SCM_API void *scm_c_call_with_unblocked_asyncs (void *(*p) (void *d), void *d);
+SCM_API void scm_dynwind_block_asyncs (void);
+SCM_API void scm_dynwind_unblock_asyncs (void);
 
 /* Critical sections */
 
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index c7908d7..dda912f 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 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 License
@@ -332,10 +332,16 @@ scm_c_shrink_bytevector (SCM bv, size_t c_new_len)
   SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
 
   if (SCM_BYTEVECTOR_CONTIGUOUS_P (bv))
-    new_bv = PTR2SCM (scm_gc_realloc (SCM2PTR (bv),
-                                     c_len + SCM_BYTEVECTOR_HEADER_BYTES,
-                                     c_new_len + SCM_BYTEVECTOR_HEADER_BYTES,
-                                     SCM_GC_BYTEVECTOR));
+    {
+      signed char *c_bv;
+
+      c_bv = scm_gc_realloc (SCM2PTR (bv),
+                            c_len + SCM_BYTEVECTOR_HEADER_BYTES,
+                            c_new_len + SCM_BYTEVECTOR_HEADER_BYTES,
+                            SCM_GC_BYTEVECTOR);
+      new_bv = PTR2SCM (c_bv);
+      SCM_BYTEVECTOR_SET_CONTENTS (new_bv, c_bv + SCM_BYTEVECTOR_HEADER_BYTES);
+    }
   else
     {
       signed char *c_bv;
diff --git a/libguile/debug.c b/libguile/debug.c
index f9bcc33..878777d 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -27,6 +27,11 @@
 #include <sys/resource.h>
 #endif
 
+#ifdef __MINGW32__
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+#endif
+
 #include "libguile/_scm.h"
 #include "libguile/async.h"
 #include "libguile/eval.h"
@@ -180,7 +185,7 @@ scm_local_eval (SCM exp, SCM env)
 static void
 init_stack_limit (void)
 {
-#ifdef HAVE_GETRLIMIT
+#if defined HAVE_GETRLIMIT
   struct rlimit lim;
   if (getrlimit (RLIMIT_STACK, &lim) == 0)
       {
@@ -194,6 +199,16 @@ init_stack_limit (void)
           SCM_STACK_LIMIT = bytes * 8 / 10 / sizeof (scm_t_bits);
       }
   errno = 0;
+#elif defined __MINGW32__
+  MEMORY_BASIC_INFORMATION m;
+  uintptr_t bytes;
+
+  if (VirtualQuery ((LPCVOID) &m, &m, sizeof m))
+    {
+      bytes = (DWORD_PTR) m.BaseAddress + m.RegionSize
+              - (DWORD_PTR) m.AllocationBase;
+      SCM_STACK_LIMIT = bytes * 8 / 10 / sizeof (scm_t_bits);
+    }
 #endif
 }
 
diff --git a/libguile/filesys.c b/libguile/filesys.c
index a2280a5..204d74e 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -50,6 +50,7 @@
 
 #include "libguile/validate.h"
 #include "libguile/filesys.h"
+#include "libguile/load.h"     /* for scm_i_mirror_backslashes */
 
 
 #ifdef HAVE_IO_H
@@ -1238,6 +1239,9 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
       errno = save_errno;
       SCM_SYSERROR;
     }
+  /* On Windows, convert backslashes in current directory to forward
+     slashes.  */
+  scm_i_mirror_backslashes (wd);
   result = scm_from_locale_stringn (wd, strlen (wd));
   free (wd);
   return result;
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 5ee225d..0cab6b8 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2010, 2011, 2012, 2013  Free Software Foundation, Inc.
+/* Copyright (C) 2010-2013  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
diff --git a/libguile/fports.c b/libguile/fports.c
index e4038de..cbd3a61 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -155,7 +155,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
   int cmode;
   long csize;
   size_t ndrained;
-  char *drained;
+  char *drained = NULL;
   scm_t_port *pt;
   scm_t_ptob_descriptor *ptob;
 
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index 650ea66..329241d 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2010, 
2011, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995-2001, 2006, 2008-2011, 2013
+ *   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
diff --git a/libguile/i18n.c b/libguile/i18n.c
index 0f607f3..c6b9b84 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software 
Foundation, Inc.
+/* Copyright (C) 2006-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
@@ -1465,6 +1465,14 @@ SCM_DEFINE (scm_locale_string_to_inexact, 
"locale-string->inexact",
    Note: We don't use Gnulib's `nl_langinfo' module because it's currently not
    as complete as the compatibility hacks in `i18n.scm'.  */
 
+static char *
+copy_string_or_null (const char *s)
+{
+  if (s == NULL)
+    return NULL;
+  else
+    return strdup (s);
+}
 
 SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
            (SCM item, SCM locale),
@@ -1496,8 +1504,8 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
   if (c_locale != NULL)
     {
 #ifdef USE_GNU_LOCALE_API
-      c_result = nl_langinfo_l (c_item, c_locale);
-      codeset = nl_langinfo_l (CODESET, c_locale);
+      c_result = copy_string_or_null (nl_langinfo_l (c_item, c_locale));
+      codeset = copy_string_or_null (nl_langinfo_l (CODESET, c_locale));
 #else /* !USE_GNU_LOCALE_API */
       /* We can't use `RUN_IN_LOCALE_SECTION ()' here because the locale
         mutex is already taken.  */
@@ -1521,8 +1529,8 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
        scm_locale_error (FUNC_NAME, lsec_err);
       else
        {
-         c_result = nl_langinfo (c_item);
-          codeset = nl_langinfo (CODESET);
+         c_result = copy_string_or_null (nl_langinfo (c_item));
+          codeset = copy_string_or_null (nl_langinfo (CODESET));
 
          restore_locale_settings (&lsec_prev_locale);
          free_locale_settings (&lsec_prev_locale);
@@ -1531,13 +1539,10 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
     }
   else
     {
-      c_result = nl_langinfo (c_item);
-      codeset = nl_langinfo (CODESET);
+      c_result = copy_string_or_null (nl_langinfo (c_item));
+      codeset = copy_string_or_null (nl_langinfo (CODESET));
     }
 
-  if (c_result != NULL)
-    c_result = strdup (c_result);
-
   unlock_locale_mutex ();
 
   if (c_result == NULL)
@@ -1580,9 +1585,13 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
          }
 #endif
 
-#if (defined FRAC_DIGITS) && (defined INT_FRAC_DIGITS)
+#if defined FRAC_DIGITS || defined INT_FRAC_DIGITS
+#ifdef FRAC_DIGITS
        case FRAC_DIGITS:
+#endif
+#ifdef INT_FRAC_DIGITS
        case INT_FRAC_DIGITS:
+#endif
          /* This is to be interpreted as a single integer.  */
          if (*c_result == CHAR_MAX)
            /* Unspecified.  */
@@ -1594,12 +1603,18 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
          break;
 #endif
 
-#if (defined P_CS_PRECEDES) && (defined INT_N_CS_PRECEDES)
+#if defined P_CS_PRECEDES || defined N_CS_PRECEDES ||  \
+  defined INT_P_CS_PRECEDES || defined INT_N_CS_PRECEDES || \
+  defined P_SEP_BY_SPACE || defined N_SEP_BY_SPACE
+#ifdef P_CS_PRECEDES
        case P_CS_PRECEDES:
        case N_CS_PRECEDES:
+#endif
+#ifdef INT_N_CS_PRECEDES
        case INT_P_CS_PRECEDES:
        case INT_N_CS_PRECEDES:
-#if (defined P_SEP_BY_SPACE) && (defined N_SEP_BY_SPACE)
+#endif
+#ifdef P_SEP_BY_SPACE
        case P_SEP_BY_SPACE:
        case N_SEP_BY_SPACE:
 #endif
@@ -1610,11 +1625,16 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
          break;
 #endif
 
-#if (defined P_SIGN_POSN) && (defined INT_N_SIGN_POSN)
+#if defined P_SIGN_POSN || defined N_SIGN_POSN || \
+  defined INT_P_SIGN_POSN || defined INT_N_SIGN_POSN
+#ifdef P_SIGN_POSN
        case P_SIGN_POSN:
        case N_SIGN_POSN:
+#endif
+#ifdef INT_P_SIGN_POSN
        case INT_P_SIGN_POSN:
        case INT_N_SIGN_POSN:
+#endif
          /* See `(libc) Sign of Money Amount' for the interpretation of the
             return value here.  */
          switch (*c_result)
@@ -1654,6 +1674,9 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
        }
     }
 
+  if (codeset != NULL)
+    free (codeset);
+
   return result;
 }
 #undef FUNC_NAME
diff --git a/libguile/init.c b/libguile/init.c
index 50ea196..d2928bd 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -310,6 +310,9 @@ scm_boot_guile (int argc, char ** argv, void (*main_func) 
(), void *closure)
   void *res;
   struct main_func_closure c;
 
+  /* On Windows, convert backslashes in argv[0] to forward
+     slashes.  */
+  scm_i_mirror_backslashes (argv[0]);
   c.main_func = main_func;
   c.closure = closure;
   c.argc = argc;
diff --git a/libguile/list.c b/libguile/list.c
index 41cc937..27ac22f 100644
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -1,5 +1,5 @@
-/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2008,2009,2010,2011
- * Free Software Foundation, Inc.
+/* Copyright (C) 1995-1997, 2000, 2001, 2003, 2004, 2008-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
@@ -179,24 +179,25 @@ SCM_DEFINE (scm_list_p, "list?", 1, 0, 0,
    long" lists (i.e. lists with cycles in their cdrs), and returns -1
    if it does find one.  */
 long
-scm_ilength(SCM sx)
+scm_ilength (SCM sx)
 {
   long i = 0;
   SCM tortoise = sx;
   SCM hare = sx;
 
-  do {
-    if (SCM_NULL_OR_NIL_P(hare)) return i;
-    if (!scm_is_pair (hare)) return -1;
-    hare = SCM_CDR(hare);
-    i++;
-    if (SCM_NULL_OR_NIL_P(hare)) return i;
-    if (!scm_is_pair (hare)) return -1;
-    hare = SCM_CDR(hare);
-    i++;
-    /* For every two steps the hare takes, the tortoise takes one.  */
-    tortoise = SCM_CDR(tortoise);
-  }
+  do
+    {
+      if (!scm_is_pair (hare))
+        return SCM_NULL_OR_NIL_P (hare) ? i : -1;
+      hare = SCM_CDR (hare);
+      i++;
+      if (!scm_is_pair (hare))
+        return SCM_NULL_OR_NIL_P (hare) ? i : -1;
+      hare = SCM_CDR (hare);
+      i++;
+      /* For every two steps the hare takes, the tortoise takes one.  */
+      tortoise = SCM_CDR (tortoise);
+    }
   while (!scm_is_eq (hare, tortoise));
 
   /* If the tortoise ever catches the hare, then the list must contain
diff --git a/libguile/load.c b/libguile/load.c
index d24b4ae..a68d96d 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -276,6 +276,41 @@ SCM_DEFINE (scm_parse_path_with_ellipsis, 
"parse-path-with-ellipsis", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+/* On Posix hosts, just return PATH unaltered.  On Windows,
+   destructively replace all backslashes in PATH with Unix-style
+   forward slashes, so that Scheme code always gets d:/foo/bar style
+   file names.  This avoids multiple subtle problems with comparing
+   file names as strings, and with redirections in /bin/sh command
+   lines.
+
+   Note that, if PATH is result of a call to 'getenv', this
+   destructively modifies the environment variables, so both
+   scm_getenv and subprocesses will afterwards see the values with
+   forward slashes.  That is OK as long as applied to Guile-specific
+   environment variables, since having scm_getenv return the same
+   value as used by the callers of this function is good for
+   consistency and file-name comparison.  Avoid using this function on
+   values returned by 'getenv' for general-purpose environment
+   variables; instead, make a copy of the value and work on that.  */
+SCM_INTERNAL char *
+scm_i_mirror_backslashes (char *path)
+{
+#ifdef __MINGW32__
+  if (path)
+    {
+      char *p = path;
+
+      while (*p)
+       {
+         if (*p == '\\')
+           *p = '/';
+         p++;
+       }
+    }
+#endif
+
+  return path;
+}
 
 /* Initialize the global variable %load-path, given the value of the
    SCM_SITE_DIR and SCM_LIBRARY_DIR preprocessor symbols and the
@@ -288,7 +323,7 @@ scm_init_load_path ()
   SCM cpath = SCM_EOL;
 
 #ifdef SCM_LIBRARY_DIR
-  env = getenv ("GUILE_SYSTEM_PATH");
+  env = scm_i_mirror_backslashes (getenv ("GUILE_SYSTEM_PATH"));
   if (env && strcmp (env, "") == 0)
     /* special-case interpret system-path=="" as meaning no system path instead
        of '("") */
@@ -301,7 +336,7 @@ scm_init_load_path ()
                        scm_from_locale_string (SCM_GLOBAL_SITE_DIR),
                        scm_from_locale_string (SCM_PKGDATA_DIR));
 
-  env = getenv ("GUILE_SYSTEM_COMPILED_PATH");
+  env = scm_i_mirror_backslashes (getenv ("GUILE_SYSTEM_COMPILED_PATH"));
   if (env && strcmp (env, "") == 0)
     /* like above */
     ; 
@@ -344,14 +379,17 @@ scm_init_load_path ()
       cachedir[0] = 0;
 
     if (cachedir[0])
-      *scm_loc_compile_fallback_path = scm_from_locale_string (cachedir);
+      {
+       scm_i_mirror_backslashes (cachedir);
+       *scm_loc_compile_fallback_path = scm_from_locale_string (cachedir);
+      }
   }
 
-  env = getenv ("GUILE_LOAD_PATH");
+  env = scm_i_mirror_backslashes (getenv ("GUILE_LOAD_PATH"));
   if (env)
     path = scm_parse_path_with_ellipsis (scm_from_locale_string (env), path);
 
-  env = getenv ("GUILE_LOAD_COMPILED_PATH");
+  env = scm_i_mirror_backslashes (getenv ("GUILE_LOAD_COMPILED_PATH"));
   if (env)
     cpath = scm_parse_path_with_ellipsis (scm_from_locale_string (env), cpath);
 
@@ -451,11 +489,10 @@ scm_c_string_has_an_ext (char *str, size_t len, SCM 
extensions)
   return 0;
 }
 
-#ifdef __MINGW32__
-#define FILE_NAME_SEPARATOR_STRING "\\"
-#else
+/* Defined as "/" for Unix and Windows alike, so that file names
+   constructed by the functions in this module wind up with Unix-style
+   forward slashes as directory separators.  */
 #define FILE_NAME_SEPARATOR_STRING "/"
-#endif
 
 static int
 is_file_name_separator (SCM c)
@@ -619,7 +656,8 @@ search_path (SCM path, SCM filename, SCM extensions, SCM 
require_exts,
          if (stat (buf.buf, stat_buf) == 0
              && ! (stat_buf->st_mode & S_IFDIR))
            {
-             result = scm_from_locale_string (buf.buf);
+             result =
+               scm_from_locale_string (scm_i_mirror_backslashes (buf.buf));
              goto end;
            }
        }
@@ -876,7 +914,7 @@ canonical_suffix (SCM fname)
 
   /* CANON should be absolute.  */
   canon = scm_canonicalize_path (fname);
-  
+
 #ifdef __MINGW32__
   {
     size_t len = scm_c_string_length (canon);
diff --git a/libguile/load.h b/libguile/load.h
index ab75ea3..986948d 100644
--- a/libguile/load.h
+++ b/libguile/load.h
@@ -44,6 +44,7 @@ SCM_INTERNAL void scm_init_load_path (void);
 SCM_INTERNAL void scm_init_load (void);
 SCM_INTERNAL void scm_init_load_should_auto_compile (void);
 SCM_INTERNAL void scm_init_eval_in_scheme (void);
+SCM_INTERNAL char *scm_i_mirror_backslashes (char *path);
 
 #endif  /* SCM_LOAD_H */
 
diff --git a/libguile/locale-categories.h b/libguile/locale-categories.h
index 26b030d..fb5ac10 100644
--- a/libguile/locale-categories.h
+++ b/libguile/locale-categories.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 2006, 2008, 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
@@ -23,8 +23,10 @@
 SCM_DEFINE_LOCALE_CATEGORY (COLLATE)
 SCM_DEFINE_LOCALE_CATEGORY (CTYPE)
 
-#ifdef LC_MESSAGES
-/* MinGW doesn't have `LC_MESSAGES'.  */
+#if defined(LC_MESSAGES) && !(defined(LC_MAX) && LC_MESSAGES > LC_MAX)
+/* MinGW doesn't have `LC_MESSAGES'.  libintl.h might define
+   `LC_MESSAGES' for MinGW to an arbitrary large value which we cannot
+   use in a call to `setlocale'.  */
 SCM_DEFINE_LOCALE_CATEGORY (MESSAGES)
 #endif
 
diff --git a/libguile/posix.c b/libguile/posix.c
index ae0f7c3..494df1e 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1346,23 +1346,21 @@ scm_open_process (SCM mode, SCM prog, SCM args)
       SCM read_port = SCM_BOOL_F, write_port = SCM_BOOL_F;
 
       /* There is no sense in catching errors on close().  */
-      if (reading) 
+      if (reading)
         {
           close (c2p[1]);
-          read_port = scm_fdes_to_port (c2p[0], "r", sym_read_pipe);
-          scm_setvbuf (read_port, scm_from_int (_IONBF), SCM_UNDEFINED);
+          read_port = scm_fdes_to_port (c2p[0], "r0", sym_read_pipe);
         }
       if (writing)
         {
           close (p2c[0]);
-          write_port = scm_fdes_to_port (p2c[1], "w", sym_write_pipe);
-          scm_setvbuf (write_port, scm_from_int (_IONBF), SCM_UNDEFINED);
+          write_port = scm_fdes_to_port (p2c[1], "w0", sym_write_pipe);
         }
-      
+
       return scm_values
         (scm_list_3 (read_port, write_port, scm_from_int (pid)));
     }
-  
+
   /* The child.  */
   if (reading)
     close (c2p[0]);
@@ -1982,9 +1980,9 @@ cpu_set_to_bitvector (const cpu_set_t *cs)
   SCM bv;
   size_t cpu;
 
-  bv = scm_c_make_bitvector (sizeof (*cs), SCM_BOOL_F);
+  bv = scm_c_make_bitvector (CPU_SETSIZE, SCM_BOOL_F);
 
-  for (cpu = 0; cpu < sizeof (*cs); cpu++)
+  for (cpu = 0; cpu < CPU_SETSIZE; cpu++)
     {
       if (CPU_ISSET (cpu, cs))
        /* XXX: This is inefficient but avoids code duplication.  */
@@ -2250,6 +2248,12 @@ void
 scm_init_posix ()
 {
   scm_add_feature ("posix");
+#ifdef EXIT_SUCCESS
+  scm_c_define ("EXIT_SUCCESS", scm_from_int (EXIT_SUCCESS));
+#endif
+#ifdef EXIT_FAILURE
+  scm_c_define ("EXIT_FAILURE", scm_from_int (EXIT_FAILURE));
+#endif
 #ifdef HAVE_GETEUID
   scm_add_feature ("EIDs");
 #endif
diff --git a/libguile/simpos.c b/libguile/simpos.c
index a657a8f..7005828 100644
--- a/libguile/simpos.c
+++ b/libguile/simpos.c
@@ -45,6 +45,10 @@
 # include <sys/wait.h>
 #endif
 
+#ifdef __MINGW32__
+# include <process.h>  /* for spawnvp and friends */
+#endif
+
 #include "posix.h"
 
 
@@ -86,8 +90,6 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0,
 
 
 #ifdef HAVE_SYSTEM
-#ifdef HAVE_WAITPID
-
 
 SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
            (SCM args),
@@ -115,11 +117,18 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
   if (scm_is_pair (args))
     {
       SCM oldint;
-      SCM oldquit;
       SCM sig_ign;
       SCM sigint;
+      /* SIGQUIT is undefined on MS-Windows.  */
+#ifdef SIGQUIT
+      SCM oldquit;
       SCM sigquit;
+#endif
+#ifdef HAVE_FORK
       int pid;
+#else
+      int status;
+#endif
       char **execargv;
 
       /* allocate before fork */
@@ -128,10 +137,13 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
       /* make sure the child can't kill us (as per normal system call) */
       sig_ign = scm_from_ulong ((unsigned long) SIG_IGN);
       sigint = scm_from_int (SIGINT);
-      sigquit = scm_from_int (SIGQUIT);
       oldint = scm_sigaction (sigint, sig_ign, SCM_UNDEFINED);
+#ifdef SIGQUIT
+      sigquit = scm_from_int (SIGQUIT);
       oldquit = scm_sigaction (sigquit, sig_ign, SCM_UNDEFINED);
-      
+#endif
+
+#ifdef HAVE_FORK
       pid = fork ();
       if (pid == 0)
         {
@@ -164,12 +176,20 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
 
           return scm_from_int (status);
         }
+#else  /* !HAVE_FORK */
+      status = spawnvp (P_WAIT, execargv[0], (const char * const *)execargv);
+      scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint));
+#ifdef SIGQUIT
+      scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit));
+#endif
+
+      return scm_from_int (status);
+#endif /* !HAVE_FORK */
     }
   else
     SCM_WRONG_TYPE_ARG (1, args);
 }
 #undef FUNC_NAME
-#endif /* HAVE_WAITPID */
 #endif /* HAVE_SYSTEM */
 
 
diff --git a/libguile/smob.h b/libguile/smob.h
index 37ea642..0e59f89 100644
--- a/libguile/smob.h
+++ b/libguile/smob.h
@@ -147,14 +147,14 @@ scm_new_double_smob (scm_t_bits tc, scm_t_bits data1,
 #define SCM_SET_SMOB_OBJECT_1(x,obj)   (SCM_SET_SMOB_OBJECT_N ((x), 1, (obj)))
 #define SCM_SET_SMOB_OBJECT_2(x,obj)   (SCM_SET_SMOB_OBJECT_N ((x), 2, (obj)))
 #define SCM_SET_SMOB_OBJECT_3(x,obj)   (SCM_SET_SMOB_OBJECT_N ((x), 3, (obj)))
-#define SCM_SMOB_OBJECT_0_LOC(x)       (SCM_SMOB_OBJECT_N_LOC ((x), 0)))
-#define SCM_SMOB_OBJECT_1_LOC(x)       (SCM_SMOB_OBJECT_N_LOC ((x), 1)))
-#define SCM_SMOB_OBJECT_2_LOC(x)       (SCM_SMOB_OBJECT_N_LOC ((x), 2)))
-#define SCM_SMOB_OBJECT_3_LOC(x)       (SCM_SMOB_OBJECT_N_LOC ((x), 3)))
+#define SCM_SMOB_OBJECT_0_LOC(x)       (SCM_SMOB_OBJECT_N_LOC ((x), 0))
+#define SCM_SMOB_OBJECT_1_LOC(x)       (SCM_SMOB_OBJECT_N_LOC ((x), 1))
+#define SCM_SMOB_OBJECT_2_LOC(x)       (SCM_SMOB_OBJECT_N_LOC ((x), 2))
+#define SCM_SMOB_OBJECT_3_LOC(x)       (SCM_SMOB_OBJECT_N_LOC ((x), 3))
 
 #define SCM_SMOB_OBJECT(x)             (SCM_SMOB_OBJECT_1 (x))
 #define SCM_SET_SMOB_OBJECT(x,obj)     (SCM_SET_SMOB_OBJECT_1 ((x), (obj)))
-#define SCM_SMOB_OBJECT_LOC(x)         (SCM_SMOB_OBJECT_1_LOC (x)))
+#define SCM_SMOB_OBJECT_LOC(x)         (SCM_SMOB_OBJECT_1_LOC (x))
 
 
 #define SCM_SMOB_APPLY_0(x)            (scm_call_0 (x))
diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c
index aaa3efe..353a746 100644
--- a/libguile/srfi-1.c
+++ b/libguile/srfi-1.c
@@ -1,7 +1,7 @@
 /* srfi-1.c --- SRFI-1 procedures for Guile
  *
- * Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2005, 2006,
- *   2008, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+ * Copyright (C) 1995-1997, 2000-2003, 2005, 2006, 2008-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 License
@@ -614,8 +614,40 @@ SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0,
            "circular.")
 #define FUNC_NAME s_scm_srfi1_length_plus
 {
-  long len = scm_ilength (lst);
-  return (len >= 0 ? SCM_I_MAKINUM (len) : SCM_BOOL_F);
+  size_t i = 0;
+  SCM tortoise = lst;
+  SCM hare = lst;
+
+  do
+    {
+      if (!scm_is_pair (hare))
+        {
+          if (SCM_NULL_OR_NIL_P (hare))
+            return scm_from_size_t (i);
+          else
+            scm_wrong_type_arg_msg (FUNC_NAME, 1, lst,
+                                    "proper or circular list");
+        }
+      hare = SCM_CDR (hare);
+      i++;
+      if (!scm_is_pair (hare))
+        {
+          if (SCM_NULL_OR_NIL_P (hare))
+            return scm_from_size_t (i);
+          else
+            scm_wrong_type_arg_msg (FUNC_NAME, 1, lst,
+                                    "proper or circular list");
+        }
+      hare = SCM_CDR (hare);
+      i++;
+      /* For every two steps the hare takes, the tortoise takes one.  */
+      tortoise = SCM_CDR (tortoise);
+    }
+  while (!scm_is_eq (hare, tortoise));
+
+  /* If the tortoise ever catches the hare, then the list must contain
+     a cycle.  */
+  return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
diff --git a/libguile/threads.c b/libguile/threads.c
index bcf1e0d..3dc0f40 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -1036,6 +1036,11 @@ SCM_DEFINE (scm_yield, "yield", 0, 0, 0,
 }
 #undef FUNC_NAME
 
+/* Some systems, notably Android, lack 'pthread_cancel'.  Don't provide
+   'cancel-thread' on these systems.  */
+
+#if !SCM_USE_PTHREAD_THREADS || defined HAVE_PTHREAD_CANCEL
+
 SCM_DEFINE (scm_cancel_thread, "cancel-thread", 1, 0, 0,
            (SCM thread),
 "Asynchronously force the target @var{thread} to terminate. @var{thread} "
@@ -1061,6 +1066,8 @@ SCM_DEFINE (scm_cancel_thread, "cancel-thread", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+#endif
+
 SCM_DEFINE (scm_set_thread_cleanup_x, "set-thread-cleanup!", 2, 0, 0,
            (SCM thread, SCM proc),
 "Set the thunk @var{proc} as the cleanup handler for the thread @var{thread}. "
diff --git a/module/Makefile.am b/module/Makefile.am
index 8de2972..7b3a4a8 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -198,7 +198,9 @@ SCRIPTS_SOURCES =                           \
   scripts/summarize-guile-TODO.scm             \
   scripts/api-diff.scm                         \
   scripts/read-rfc822.scm                      \
-  scripts/snarf-guile-m4-docs.scm
+  scripts/snarf-guile-m4-docs.scm              \
+  scripts/autofrisk.scm                                \
+  scripts/scan-api.scm
 
 SYSTEM_BASE_SOURCES =                          \
   system/base/pmatch.scm                       \
@@ -248,6 +250,7 @@ ICE_9_SOURCES = \
   ice-9/peg.scm \
   ice-9/poe.scm \
   ice-9/poll.scm \
+  ice-9/popen.scm \
   ice-9/posix.scm \
   ice-9/q.scm \
   ice-9/rdelim.scm \
@@ -280,18 +283,6 @@ ICE_9_SOURCES = \
   ice-9/local-eval.scm \
   ice-9/unicode.scm
 
-if BUILD_ICE_9_POPEN
-
-# This functionality is missing on systems without `fork'---i.e., Windows.
-ICE_9_SOURCES += ice-9/popen.scm
-
-# These modules rely on (ice-9 popen).
-SCRIPTS_SOURCES +=                             \
-  scripts/autofrisk.scm                                \
-  scripts/scan-api.scm
-
-endif BUILD_ICE_9_POPEN
-
 srfi/srfi-64.go: srfi/srfi-64.scm srfi/srfi-64/testing.scm
 
 SRFI_SOURCES = \
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 7f38c4b..a5b3422 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1,8 +1,6 @@
 ;;; -*- 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, 2014
-;;;;   Free Software Foundation, Inc.
+;;;; Copyright (C) 1995-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
@@ -430,13 +428,15 @@ file with the given name already exists, the effect is 
unspecified."
   (syntax-rules ()
     ((_) #t)
     ((_ x) x)
-    ((_ x y ...) (if x (and y ...) #f))))
+    ;; Avoid ellipsis, which would lead to quadratic expansion time.
+    ((_ x . y) (if x (and . y) #f))))
 
 (define-syntax or
   (syntax-rules ()
     ((_) #f)
     ((_ x) x)
-    ((_ x y ...) (let ((t x)) (if t t (or y ...))))))
+    ;; Avoid ellipsis, which would lead to quadratic expansion time.
+    ((_ x . y) (let ((t x)) (if t t (or . y))))))
 
 (include-from-path "ice-9/quasisyntax")
 
@@ -1891,7 +1891,7 @@ written into the port is returned."
        (or (char=? c #\/)
            (char=? c #\\)))
 
-     (define file-name-separator-string "\\")
+     (define file-name-separator-string "/")
 
      (define (absolute-file-name? file-name)
        (define (file-name-separator-at-index? idx)
@@ -1982,7 +1982,7 @@ written into the port is returned."
 (define-syntax-rule (add-to-load-path elt)
   "Add ELT to Guile's load path, at compile-time and at run-time."
   (eval-when (expand load eval)
-    (set! %load-path (cons elt %load-path))))
+    (set! %load-path (cons elt (delete elt %load-path)))))
 
 (define %load-verbosely #f)
 (define (assert-load-verbosity v) (set! %load-verbosely v))
diff --git a/module/ice-9/curried-definitions.scm 
b/module/ice-9/curried-definitions.scm
index fa36990..7545338 100644
--- a/module/ice-9/curried-definitions.scm
+++ b/module/ice-9/curried-definitions.scm
@@ -17,7 +17,8 @@
 (define-module (ice-9 curried-definitions)
   #:replace ((cdefine . define)
              (cdefine* . define*)
-             define-public))
+             define-public
+             define*-public))
 
 (define-syntax cdefine
   (syntax-rules ()
@@ -44,3 +45,13 @@
      (begin
        (define name val)
        (export name)))))
+
+(define-syntax define*-public
+  (syntax-rules ()
+    ((_ (head . rest) body body* ...)
+     (define*-public head
+       (lambda* rest body body* ...)))
+    ((_ name val)
+     (begin
+       (define* name val)
+       (export name)))))
diff --git a/module/ice-9/rdelim.scm b/module/ice-9/rdelim.scm
index 32908cc..a406f4e 100644
--- a/module/ice-9/rdelim.scm
+++ b/module/ice-9/rdelim.scm
@@ -1,7 +1,8 @@
 ;;; installed-scm-file
 
-;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010, 2013 Free Software 
Foundation, Inc.
-;;;; 
+;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010, 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
 ;;;; License as published by the Free Software Foundation; either
@@ -148,26 +149,29 @@ left in the port."
                 (lp (1+ n)))))
         (- n start))))
 
-(define* (read-string #:optional (port (current-input-port)) (count #f))
-  "Read all of the characters out of PORT and return them as a string.
+(define* read-string
+  (case-lambda*
+   "Read all of the characters out of PORT and return them as a string.
 If the COUNT argument is present, treat it as a limit to the number of
 characters to read.  By default, there is no limit."
-  (check-arg (or (not count) (index? count)) "bad count" count)
-  (let loop ((substrings '())
-             (total-chars 0)
-             (buf-size 100))           ; doubled each time through.
-    (let* ((buf (make-string (if count
-                                 (min buf-size (- count total-chars))
-                                 buf-size)))
-           (nchars (read-string! buf port))
-           (new-total (+ total-chars nchars)))
-      (cond
-       ((= nchars buf-size)
-        ;; buffer filled.
-        (loop (cons buf substrings) new-total (* buf-size 2)))
-       (else
-        (string-concatenate-reverse
-         (cons (substring buf 0 nchars) substrings)))))))
+   ((#:optional (port (current-input-port)))
+    ;; Fast path.
+    ;; This creates more garbage than using 'string-set!' as in
+    ;; 'read-string!', but currently that is faster nonetheless.
+    (let loop ((chars '()))
+      (let ((char (read-char port)))
+        (if (eof-object? char)
+            (list->string (reverse! chars))
+            (loop (cons char chars))))))
+   ((port count)
+    ;; Slower path.
+    (let loop ((chars '())
+               (total 0))
+      (let ((char (read-char port)))
+        (if (or (eof-object? char) (>= total count))
+            (list->string (reverse chars))
+            (loop (cons char chars) (+ 1 total))))))))
+
 
 ;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string
 ;;; from PORT.  The return value depends on the value of HANDLE-DELIM,
diff --git a/module/language/tree-il/analyze.scm 
b/module/language/tree-il/analyze.scm
index 0ce7344..1c06127 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -1,6 +1,6 @@
 ;;; TREE-IL -> GLIL compiler
 
-;; Copyright (C) 2001, 2008, 2009, 2010, 2011, 2012, 2013 Free Software 
Foundation, Inc.
+;; Copyright (C) 2001, 2008-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
@@ -1222,6 +1222,16 @@ given `tree-il' element."
                               conditions end-group
                               (+ 1 min-count)
                               (+ 1 max-count)))
+             ((#\p #\P) (let* ((colon?    (memq #\: params))
+                               (min-count (if colon?
+                                              (max 1 min-count)
+                                              (+ 1 min-count))))
+                          (loop (cdr chars) 'literal '()
+                                conditions end-group
+                                min-count
+                                (if colon?
+                                    (max max-count min-count)
+                                    (+ 1 max-count)))))
              ((#\[)
               (loop chars 'literal '() '()
                     (let ((selector (previous-number params))
diff --git a/module/language/tree-il/peval.scm 
b/module/language/tree-il/peval.scm
index f70d3b1..3daa2ec 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1,6 +1,6 @@
 ;;; Tree-IL partial evaluator
 
-;; Copyright (C) 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 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
@@ -1405,18 +1405,31 @@ top-level bindings from ENV and return the resulting 
expression."
                                 gensyms
                                 (append req-vals opt-vals rest-vals)
                                 body)
-                      ;; The required argument values are in the scope
-                      ;; of the optional argument initializers.
+                      ;; The default initializers of optional arguments
+                      ;; may refer to earlier arguments, so in the general
+                      ;; case we must expand into a series of nested let
+                      ;; expressions.
+                      ;;
+                      ;; In the generated code, the outermost let
+                      ;; expression will bind all required arguments, as
+                      ;; well as the empty rest argument, if any.  Each
+                      ;; optional argument will be bound within an inner
+                      ;; let.
                       (make-let src
                                 (append req rest)
                                 (append (list-head gensyms nreq)
                                         (last-pair gensyms))
                                 (append req-vals rest-vals)
-                                (make-let src
-                                          opt
-                                          (list-head (drop gensyms nreq) nopt)
-                                          opt-vals
-                                          body)))))
+                                (fold-right (lambda (var gensym val body)
+                                              (make-let src
+                                                        (list var)
+                                                        (list gensym)
+                                                        (list val)
+                                                        body))
+                                            body
+                                            opt
+                                            (list-head (drop gensyms nreq) 
nopt)
+                                            opt-vals)))))
 
               (cond
                ((or (< nargs nreq) (and (not rest) (> nargs (+ nreq nopt))))
diff --git a/module/scripts/compile.scm b/module/scripts/compile.scm
index ab2c456..5b644c3 100644
--- a/module/scripts/compile.scm
+++ b/module/scripts/compile.scm
@@ -1,6 +1,6 @@
 ;;; Compile --- Command-line Guile Scheme compiler  -*- coding: iso-8859-1 -*-
 
-;; Copyright 2005,2008,2009,2010,2011,2013 Free Software Foundation, Inc.
+;; Copyright 2005, 2008-2011, 2013, 2014 Free Software Foundation, Inc.
 ;;
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public License
@@ -176,6 +176,14 @@ Report bugs to <~A>.~%"
         (fail "`-o' option can only be specified "
               "when compiling a single file"))
 
+    ;; Install a SIGINT handler.  As a side effect, this gives unwind
+    ;; handlers an opportunity to run upon SIGINT; this includes that of
+    ;; 'call-with-output-file/atomic', called by 'compile-file', which
+    ;; removes the temporary output file.
+    (sigaction SIGINT
+      (lambda args
+        (fail "interrupted by the user")))
+
     (for-each (lambda (file)
                 (format #t "wrote `~A'\n"
                         (with-fluids ((*current-warning-prefix* ""))
diff --git a/module/srfi/srfi-43.scm b/module/srfi/srfi-43.scm
index 88a3f3f..153b0cb 100644
--- a/module/srfi/srfi-43.scm
+++ b/module/srfi/srfi-43.scm
@@ -104,10 +104,10 @@
 
 The fundamental vector constructor.  Create a vector whose length is
 LENGTH and iterates across each index k from 0 up to LENGTH - 1,
-applying F at each iteration to the current index and current seeds,
-in that order, to receive n + 1 values: first, the element to put in
-the kth slot of the new vector and n new seeds for the next iteration.
-It is an error for the number of seeds to vary between iterations."
+applying F at each iteration to the current index and current seeds, in
+that order, to receive n + 1 values: the element to put in the kth slot
+of the new vector, and n new seeds for the next iteration.  It is an
+error for the number of seeds to vary between iterations."
     ((f len)
      (assert-procedure f 'vector-unfold)
      (assert-nonneg-exact-integer len 'vector-unfold)
@@ -154,10 +154,10 @@ It is an error for the number of seeds to vary between 
iterations."
 
 The fundamental vector constructor.  Create a vector whose length is
 LENGTH and iterates across each index k from LENGTH - 1 down to 0,
-applying F at each iteration to the current index and current seeds,
-in that order, to receive n + 1 values: first, the element to put in
-the kth slot of the new vector and n new seeds for the next iteration.
-It is an error for the number of seeds to vary between iterations."
+applying F at each iteration to the current index and current seeds, in
+that order, to receive n + 1 values: the element to put in the kth slot
+of the new vector, and n new seeds for the next iteration.  It is an
+error for the number of seeds to vary between iterations."
     ((f len)
      (assert-procedure f 'vector-unfold-right)
      (assert-nonneg-exact-integer len 'vector-unfold-right)
@@ -304,7 +304,7 @@ from the subsequent locations in VEC ..."
 
 Append each vector in LIST-OF-VECTORS.  Equivalent to:
   (apply vector-append LIST-OF-VECTORS)"
-  (assert-vectors vs 'vector-append)
+  (assert-vectors vs 'vector-concatenate)
   (%vector-concatenate vs))
 
 (define (vector-empty? vec)
diff --git a/module/system/base/target.scm b/module/system/base/target.scm
index ce5ff33..e545674 100644
--- a/module/system/base/target.scm
+++ b/module/system/base/target.scm
@@ -1,6 +1,6 @@
 ;;; Compilation targets
 
-;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 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
@@ -70,6 +70,14 @@
              (endianness big))
             ((string-match "^arm.*el" cpu)
              (endianness little))
+            ((string-match "^arm.*eb" cpu)
+             (endianness big))
+            ((string-prefix? "arm" cpu)          ;ARMs are LE by default
+             (endianness little))
+            ((string-match "^aarch64.*be" cpu)
+             (endianness big))
+            ((string=? "aarch64" cpu)
+             (endianness little))
             (else
              (error "unknown CPU endianness" cpu)))))
 
@@ -93,7 +101,7 @@
           ((string-match "^x86_64-.*-gnux32" triplet) 4)  ; x32
 
           ((string-match "64$" cpu) 8)
-          ((string-match "64[lbe][lbe]$" cpu) 8)
+          ((string-match "64_?[lbe][lbe]$" cpu) 8)
           ((member cpu '("sparc" "powerpc" "mips" "mipsel")) 4)
           ((string-match "^arm.*" cpu) 4)
           (else (error "unknown CPU word size" cpu)))))
diff --git a/module/web/client.scm b/module/web/client.scm
index 3f6c45b..070b0c3 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -1,6 +1,6 @@
 ;;; Web client
 
-;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 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
@@ -92,8 +92,6 @@
 
           ;; Buffer input and output on this port.
           (setvbuf s _IOFBF)
-          ;; Enlarge the receive buffer.
-          (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024))
           ;; If we're using a proxy, make a note of that.
           (when http-proxy (set-http-proxy-port?! s #t))
           s)
diff --git a/test-suite/standalone/Makefile.am 
b/test-suite/standalone/Makefile.am
index ce5f369..5138b15 100644
--- a/test-suite/standalone/Makefile.am
+++ b/test-suite/standalone/Makefile.am
@@ -93,6 +93,9 @@ check_SCRIPTS += test-language
 TESTS += test-language
 EXTRA_DIST += test-language.el test-language.js
 
+check_SCRIPTS += test-guild-compile
+TESTS += test-guild-compile
+
 # test-num2integral
 test_num2integral_SOURCES = test-num2integral.c
 test_num2integral_CFLAGS = ${test_cflags}
@@ -190,7 +193,8 @@ TESTS += test-scm-c-read
 # test-scm-take-locale-symbol
 test_scm_take_locale_symbol_SOURCES = test-scm-take-locale-symbol.c
 test_scm_take_locale_symbol_CFLAGS = ${test_cflags}
-test_scm_take_locale_symbol_LDADD = $(LIBGUILE_LDADD)
+test_scm_take_locale_symbol_LDADD =                    \
+  $(LIBGUILE_LDADD) $(top_builddir)/lib/libgnu.la
 check_PROGRAMS += test-scm-take-locale-symbol
 TESTS += test-scm-take-locale-symbol
 
diff --git a/test-suite/standalone/test-guild-compile 
b/test-suite/standalone/test-guild-compile
new file mode 100755
index 0000000..525ecc6
--- /dev/null
+++ b/test-suite/standalone/test-guild-compile
@@ -0,0 +1,42 @@
+#!/bin/sh
+#
+# This -*- sh -*- script tests whether 'guild compile' leaves traces
+# behind it upon SIGINT.
+
+source="t-guild-compile-$$"
+target="$source.go"
+
+trap 'rm -f "$source" "$target"' EXIT
+
+cat > "$source"<<EOF
+(eval-when (expand load eval)
+  (sleep 100))
+(define chbouib 42)
+EOF
+
+guild compile -o "$target" "$source" &
+pid="$!"
+
+# Send SIGINT.
+sleep 2 && kill -INT "$pid"
+
+# Wait for 'guild compile' to terminate.
+sleep 2
+
+# Check whether there are any leftovers.
+for file in "$target"*
+do
+    if test "$file" != "${target}*"
+    then
+       echo "error: 'guild compile' failed to remove '$file'" >&2
+       rm "$target"*
+       kill "$pid"
+       exit 1
+    fi
+done
+
+if test -f "$target"
+then
+    echo "error: '$target' produced" >&2
+    exit 1
+fi
diff --git a/test-suite/test-suite/lib.scm b/test-suite/test-suite/lib.scm
index b571122..27620a7 100644
--- a/test-suite/test-suite/lib.scm
+++ b/test-suite/test-suite/lib.scm
@@ -63,6 +63,9 @@
  ;; Using a given locale
  with-locale with-locale* with-latin1-locale with-latin1-locale*
 
+ ;; The bit bucket.
+ %null-device
+
  ;; Reporting results in various ways.
  register-reporter unregister-reporter reporter-registered?
  make-count-reporter print-counts
@@ -564,6 +567,17 @@
     ((_ body ...)
      (with-latin1-locale* (lambda () body ...)))))
 
+(define %null-device
+  ;; On Windows (MinGW), /dev/null does not exist and we must instead
+  ;; use NUL.  Note that file system procedures automatically translate
+  ;; /dev/null, so this variable is only useful for shell snippets.
+
+  ;; Test for Windowsness by checking whether the current directory name
+  ;; starts with a drive letter.
+  (if (string-match "^[a-zA-Z]:[/\\]" (getcwd))
+      "NUL"
+      "/dev/null"))
+
 
 ;;;; REPORTERS
 ;;;;
diff --git a/test-suite/tests/c-api.test b/test-suite/tests/c-api.test
index 9a2108e..5ce033f 100644
--- a/test-suite/tests/c-api.test
+++ b/test-suite/tests/c-api.test
@@ -1,7 +1,7 @@
 ;;;; c-api.test --- complementary test suite for the c-api     -*- scheme -*-
 ;;;; MDJ 990915 <address@hidden>
 ;;;;
-;;;;   Copyright (C) 1999, 2006, 2012 Free Software Foundation, Inc.
+;;;;   Copyright (C) 1999, 2006, 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
@@ -22,7 +22,8 @@
 (define srcdir (cdr (assq 'srcdir %guile-build-info)))
 
 (define (egrep string filename)
-  (zero? (system (string-append "egrep '" string "' " filename " 
>/dev/null"))))
+  (zero? (system (string-append "egrep '" string "' " filename
+                                " >" %null-device))))
 
 (define (seek-offset-test dirname)
   (let ((dir (opendir dirname)))
diff --git a/test-suite/tests/coding.test b/test-suite/tests/coding.test
index b57ef7d..5f643f8 100644
--- a/test-suite/tests/coding.test
+++ b/test-suite/tests/coding.test
@@ -20,7 +20,10 @@
   #:use-module (test-suite lib))
 
 (define (with-temp-file proc)
-  (let* ((name (string-copy "/tmp/coding-test.XXXXXX"))
+  (let* ((tmpdir (or (getenv "TMPDIR")
+                     (getenv "TEMP")
+                     "/tmp"))
+         (name (string-append tmpdir "/coding-test.XXXXXX"))
          (port (mkstemp! name)))
     (let ((res (with-throw-handler
                 #t
diff --git a/test-suite/tests/cross-compilation.test 
b/test-suite/tests/cross-compilation.test
index 5438c20..175e640 100644
--- a/test-suite/tests/cross-compilation.test
+++ b/test-suite/tests/cross-compilation.test
@@ -1,6 +1,6 @@
 ;;;; Cross compilation   -*- mode: scheme; coding: utf-8; -*-
 ;;;;
-;;;;   Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2010-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
@@ -79,6 +79,14 @@
                (endianness little) 8)
   (test-target "x86_64-unknown-linux-gnux32"      ; x32 ABI (Debian tuplet)
                (endianness little) 4)
+  (test-target "arm-unknown-linux-androideabi"
+               (endianness little) 4)
+  (test-target "armeb-unknown-linux-gnu"
+               (endianness big) 4)
+  (test-target "aarch64-linux-gnu"
+               (endianness little) 8)
+  (test-target "aarch64_be-linux-gnu"
+               (endianness big) 8)
 
   (pass-if-exception "unknown target" exception:miscellaneous-error
     (with-target "fcpu-unknown-gnu1.0"
diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test
index b980cdc..c63e3ac 100644
--- a/test-suite/tests/i18n.test
+++ b/test-suite/tests/i18n.test
@@ -1,7 +1,7 @@
 ;;;; i18n.test --- Exercise the i18n API.  -*- coding: utf-8; mode: scheme; -*-
 ;;;;
 ;;;; Copyright (C) 2006, 2007, 2009, 2010, 2011, 2012,
-;;;;   2013 Free Software Foundation, Inc.
+;;;;   2013, 2014 Free Software Foundation, Inc.
 ;;;; Ludovic Courtès
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -38,18 +38,18 @@
     (not (not (make-locale LC_ALL "C"))))
 
   (pass-if "make-locale (2 args, list)"
-    (not (not (make-locale (list LC_COLLATE LC_MESSAGES) "C"))))
+    (not (not (make-locale (list LC_COLLATE LC_NUMERIC) "C"))))
 
   (pass-if "make-locale (3 args)"
     (not (not (make-locale (list LC_COLLATE) "C"
-                           (make-locale (list LC_MESSAGES) "C")))))
+                           (make-locale (list LC_NUMERIC) "C")))))
 
   (pass-if-exception "make-locale with unknown locale" exception:locale-error
     (make-locale LC_ALL "does-not-exist"))
 
   (pass-if "locale?"
     (and (locale? (make-locale (list LC_ALL) "C"))
-         (locale? (make-locale (list LC_MESSAGES LC_NUMERIC) "C"
+         (locale? (make-locale (list LC_TIME LC_NUMERIC) "C"
                                (make-locale (list LC_CTYPE) "C")))))
 
   (pass-if "%global-locale"
@@ -81,20 +81,36 @@
                              (make-locale (list LC_COLLATE) "C")))))
 
 
+(define mingw?
+  (string-contains %host-type "-mingw32"))
+
 (define %french-locale-name
-  "fr_FR.ISO-8859-1")
+  (if mingw?
+      "fra_FRA.850"
+      "fr_FR.ISO-8859-1"))
+
+;; What we really want for the following locales is that they be Unicode
+;; capable, not necessarily UTF-8, which Windows does not provide.
 
 (define %french-utf8-locale-name
-  "fr_FR.UTF-8")
+  (if mingw?
+      "fra_FRA.1252"
+      "fr_FR.UTF-8"))
 
 (define %turkish-utf8-locale-name
-  "tr_TR.UTF-8")
+  (if mingw?
+      "tur_TRK.1254"
+      "tr_TR.UTF-8"))
 
 (define %german-utf8-locale-name
-  "de_DE.UTF-8")
+  (if mingw?
+      "deu_DEU.1252"
+      "de_DE.UTF-8"))
 
 (define %greek-utf8-locale-name
-  "el_GR.UTF-8")
+  (if mingw?
+      "grc_ELL.1253"
+      "el_GR.UTF-8"))
 
 (define %american-english-locale-name
   "en_US")
@@ -148,13 +164,14 @@
   (under-locale-or-unresolved %french-utf8-locale thunk))
 
 (define (under-turkish-utf8-locale-or-unresolved thunk)
-  ;; FreeBSD 8.2 and 9.1, Solaris 2.10, and Darwin 8.11.0 have a broken
-  ;; tr_TR locale where `i' is mapped to uppercase `I' instead of `Ä°',
-  ;; so disable tests on that platform.
+  ;; FreeBSD 8.2 and 9.1, Solaris 2.10, Darwin 8.11.0, and MinGW have
+  ;; a broken tr_TR locale where `i' is mapped to uppercase `I'
+  ;; instead of `Ä°', so disable tests on that platform.
   (if (or (string-contains %host-type "freebsd8")
           (string-contains %host-type "freebsd9")
           (string-contains %host-type "solaris2.10")
-          (string-contains %host-type "darwin8"))
+          (string-contains %host-type "darwin8")
+          (string-contains %host-type "mingw32"))
       (throw 'unresolved)
       (under-locale-or-unresolved %turkish-utf8-locale thunk)))
 
@@ -192,7 +209,7 @@
         ;; strings.
         (dynamic-wind
           (lambda ()
-            (setlocale LC_ALL "fr_FR.UTF-8"))
+            (setlocale LC_ALL %french-utf8-locale-name))
           (lambda ()
             (string-locale-ci=? "œuf" "ŒUF"))
           (lambda ()
diff --git a/test-suite/tests/modules.test b/test-suite/tests/modules.test
index fb54061..5e08ac9 100644
--- a/test-suite/tests/modules.test
+++ b/test-suite/tests/modules.test
@@ -1,6 +1,6 @@
 ;;;; modules.test --- exercise some of guile's module stuff -*- scheme -*-
 
-;;;; Copyright (C) 2006, 2007, 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2006, 2007, 2009-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
@@ -18,8 +18,7 @@
 
 (define-module (test-suite test-modules)
   #:use-module (srfi srfi-1)
-  #:use-module ((ice-9 streams)  ;; for test purposes
-                #:renamer (symbol-prefix-proc 's:))
+  #:use-module ((ice-9 streams) #:prefix s:)  ; for test purposes
   #:use-module (test-suite lib))
 
 
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index 2c1c609..7cc5a31 100644
--- a/test-suite/tests/peval.test
+++ b/test-suite/tests/peval.test
@@ -1,7 +1,7 @@
 ;;;; tree-il.test --- test suite for compiling tree-il   -*- scheme -*-
 ;;;; Andy Wingo <address@hidden> --- May 2009
 ;;;;
-;;;;   Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Free Software 
Foundation, Inc.
+;;;;   Copyright (C) 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
@@ -410,6 +410,90 @@
     (const 7))
 
   (pass-if-peval
+    ;; Higher order with optional argument (default uses earlier argument).
+    ;; <http://bugs.gnu.org/17634>
+    ((lambda* (f x #:optional (y (+ 3 (car x))))
+       (+ y (f (* (car x) (cadr x)))))
+     (lambda (x)
+       (+ x 1))
+     '(2 3))
+    (const 12))
+
+  (pass-if-peval
+    ;; Higher order with optional arguments
+    ;; (default uses earlier optional argument).
+    ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y)))
+       (+ y z (f (* (car x) (cadr x)))))
+     (lambda (x)
+       (+ x 1))
+     '(2 3))
+    (const 20))
+
+  (pass-if-peval
+    ;; Higher order with optional arguments (one caller-supplied value,
+    ;; one default that uses earlier optional argument).
+    ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y)))
+       (+ y z (f (* (car x) (cadr x)))))
+     (lambda (x)
+       (+ x 1))
+     '(2 3)
+     -3)
+    (const 4))
+
+  (pass-if-peval
+    ;; Higher order with optional arguments (caller-supplied values).
+    ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y)))
+       (+ y z (f (* (car x) (cadr x)))))
+     (lambda (x)
+       (+ x 1))
+     '(2 3)
+     -3
+     17)
+    (const 21))
+
+  (pass-if-peval
+    ;; Higher order with optional and rest arguments (one
+    ;; caller-supplied value, one default that uses earlier optional
+    ;; argument).
+    ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y))
+                 #:rest r)
+       (list r (+ y z (f (* (car x) (cadr x))))))
+     (lambda (x)
+       (+ x 1))
+     '(2 3)
+     -3)
+    (primcall list (const ()) (const 4)))
+
+  (pass-if-peval
+    ;; Higher order with optional and rest arguments
+    ;; (caller-supplied values for optionals).
+    ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y))
+                 #:rest r)
+       (list r (+ y z (f (* (car x) (cadr x))))))
+     (lambda (x)
+       (+ x 1))
+     '(2 3)
+     -3
+     17)
+    (primcall list (const ()) (const 21)))
+
+  (pass-if-peval
+    ;; Higher order with optional and rest arguments
+    ;; (caller-supplied values for optionals and rest).
+    ((lambda* (f x #:optional (y (+ 3 (car x))) (z (+ (cadr x) y))
+                 #:rest r)
+       (list r (+ y z (f (* (car x) (cadr x))))))
+     (lambda (x)
+       (+ x 1))
+     '(2 3)
+     -3
+     17
+     8
+     3)
+    (let (r) (_) ((primcall list (const 8) (const 3)))
+         (primcall list (lexical r _) (const 21))))
+
+  (pass-if-peval
     ;; Higher order with optional argument (caller-supplied value).
     ((lambda* (f x #:optional (y 0))
        (+ y (f (* (car x) (cadr x)))))
diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test
index 2818be0..2c08774 100644
--- a/test-suite/tests/popen.test
+++ b/test-suite/tests/popen.test
@@ -1,6 +1,6 @@
 ;;;; popen.test --- exercise ice-9/popen.scm      -*- scheme -*-
 ;;;;
-;;;; Copyright 2003, 2006, 2010, 2011, 2013 Free Software Foundation, Inc.
+;;;; Copyright 2003, 2006, 2010, 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
@@ -36,8 +36,7 @@
       restore-signals))
 
 (define-syntax-rule (if-supported body ...)
-  (if (provided? 'fork)
-      (begin body ...)))
+  (begin body ...))
 
 (if-supported
  (use-modules (ice-9 popen))
@@ -109,7 +108,9 @@
                       (with-input-from-port (car p2c)
                         (lambda ()
                           (open-input-pipe
-                           "exec 1>/dev/null; echo closed 1>&2; exec 
2>/dev/null; read REPLY")))))))
+                           (format #f "exec 1>~a; echo closed 1>&2; \
+exec 2>~a; read REPLY"
+                                   %null-device %null-device))))))))
        (close-port (cdr c2p)) ;; write side
        (let ((result (eof-object? (read-char port))))
          (display "hello!\n" (cdr p2c))
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index fb3299b..30c2c3a 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -53,12 +53,12 @@
   (let loop ((chars '()))
     (let ((char (read-char port)))
       (if (eof-object? char)
-         (list->string (reverse! chars))
-         (loop (cons char chars))))))
+          (list->string (reverse! chars))
+          (loop (cons char chars))))))
 
 (define (read-file filename)
   (let* ((port (open-input-file filename))
-        (string (read-all port)))
+         (string (read-all port)))
     (close-port port)
     string))
 
@@ -95,7 +95,7 @@
 
 ;;; Write out an s-expression, and read it back.
 (let ((string '("From fairest creatures we desire increase,"
-               "That thereby beauty's rose might never die,"))
+                "That thereby beauty's rose might never die,"))
       (filename (test-file)))
   (let ((port (open-output-file filename)))
     (write string port)
@@ -103,10 +103,10 @@
   (let ((port (open-input-file filename)))
     (let ((in-string (read port)))
       (pass-if "file: write and read back list of strings" 
-              (equal? string in-string)))
+               (equal? string in-string)))
     (close-port port))
   (delete-file filename))
-         
+
 ;;; Write out a string, and read it back a character at a time.
 (let ((string "This is a test string\nwith no newline at the end")
       (filename (test-file)))
@@ -115,7 +115,7 @@
     (close-port port))
   (let ((in-string (read-file filename)))
     (pass-if "file: write and read back characters"
-            (equal? string in-string)))
+             (equal? string in-string)))
   (delete-file filename))
 
 ;;; Buffered input/output port with seeking.
@@ -124,17 +124,17 @@
   (display "J'Accuse" port)
   (seek port -1 SEEK_CUR)
   (pass-if "file: r/w 1"
-          (char=? (read-char port) #\e))
+           (char=? (read-char port) #\e))
   (pass-if "file: r/w 2"
-          (eof-object? (read-char port)))
+           (eof-object? (read-char port)))
   (seek port -1 SEEK_CUR)
   (write-char #\x port)
   (seek port 7 SEEK_SET)
   (pass-if "file: r/w 3"
-          (char=? (read-char port) #\x))
+           (char=? (read-char port) #\x))
   (seek port -2 SEEK_END)
   (pass-if "file: r/w 4"
-          (char=? (read-char port) #\s))
+           (char=? (read-char port) #\s))
   (close-port port)
   (delete-file filename))
 
@@ -144,17 +144,17 @@
   (display "J'Accuse" port)
   (seek port -1 SEEK_CUR)
   (pass-if "file: ub r/w 1"
-          (char=? (read-char port) #\e))
+           (char=? (read-char port) #\e))
   (pass-if "file: ub r/w 2"
-          (eof-object? (read-char port)))
+           (eof-object? (read-char port)))
   (seek port -1 SEEK_CUR)
   (write-char #\x port)
   (seek port 7 SEEK_SET)
   (pass-if "file: ub r/w 3"
-          (char=? (read-char port) #\x))
+           (char=? (read-char port) #\x))
   (seek port -2 SEEK_END)
   (pass-if "file: ub r/w 4"
-          (char=? (read-char port) #\s))
+           (char=? (read-char port) #\s))
   (close-port port)
   (delete-file filename))
 
@@ -163,24 +163,24 @@
        (port (open-output-file filename)))
   (display "J'Accuse" port)
   (pass-if "file: out tell"
-          (= (seek port 0 SEEK_CUR) 8))
+           (= (seek port 0 SEEK_CUR) 8))
   (seek port -1 SEEK_CUR)
   (write-char #\x port)
   (close-port port)
   (let ((iport (open-input-file filename)))
     (pass-if "file: in tell 0"
-            (= (seek iport 0 SEEK_CUR) 0))
+             (= (seek iport 0 SEEK_CUR) 0))
     (read-char iport)
     (pass-if "file: in tell 1"
-            (= (seek iport 0 SEEK_CUR) 1))
+             (= (seek iport 0 SEEK_CUR) 1))
     (unread-char #\z iport)
     (pass-if "file: in tell 0 after unread"
-            (= (seek iport 0 SEEK_CUR) 0))
+             (= (seek iport 0 SEEK_CUR) 0))
     (pass-if "file: unread char still there"
-            (char=? (read-char iport) #\z))
+             (char=? (read-char iport) #\z))
     (seek iport 7 SEEK_SET)
     (pass-if "file: in last char"
-            (char=? (read-char iport) #\x))
+             (char=? (read-char iport) #\x))
     (close-port iport))
   (delete-file filename))
 
@@ -188,20 +188,20 @@
 (let* ((filename (test-file))
        (port (open-output-file filename)))
   (display (string #\nul (integer->char 255) (integer->char 128)
-                  #\nul) port)
+                   #\nul) port)
   (close-port port)
   (let* ((port (open-input-file filename))
-        (line (read-line port)))
+         (line (read-line port)))
     (pass-if "file: read back NUL 1"
-            (char=? (string-ref line 0) #\nul))
+             (char=? (string-ref line 0) #\nul))
     (pass-if "file: read back 255"
-            (char=? (string-ref line 1) (integer->char 255)))
+             (char=? (string-ref line 1) (integer->char 255)))
     (pass-if "file: read back 128"
-            (char=? (string-ref line 2) (integer->char 128)))
+             (char=? (string-ref line 2) (integer->char 128)))
     (pass-if "file: read back NUL 2"
-            (char=? (string-ref line 3) #\nul))
+             (char=? (string-ref line 3) #\nul))
     (pass-if "file: EOF"
-            (eof-object? (read-char port)))
+             (eof-object? (read-char port)))
     (close-port port))
   (delete-file filename))
 
@@ -211,11 +211,11 @@
        (test-string "one line more or less"))
   (write-line test-string port)
   (let* ((in-port (open-input-file filename))
-        (line (read-line in-port)))
+         (line (read-line in-port)))
     (close-port in-port)
     (close-port port)
     (pass-if "file: line buffering"
-            (string=? line test-string)))
+             (string=? line test-string)))
   (delete-file filename))
 
 ;;; read-line should use the port encoding (not the locale encoding).
@@ -573,19 +573,19 @@
 
 ;;; ungetting characters and strings.
 (with-input-from-string "walk on the moon\nmoon"
-                       (lambda ()
-                         (read-char)
-                         (unread-char #\a (current-input-port))
-                         (pass-if "unread-char"
-                                  (char=? (read-char) #\a))
-                         (read-line)
-                         (let ((replacenoid "chicken enchilada"))
-                           (unread-char #\newline (current-input-port))
-                           (unread-string replacenoid (current-input-port))
-                           (pass-if "unread-string"
-                                    (string=? (read-line) replacenoid)))
-                         (pass-if "unread residue"
-                                  (string=? (read-line) "moon"))))
+                        (lambda ()
+                          (read-char)
+                          (unread-char #\a (current-input-port))
+                          (pass-if "unread-char"
+                                   (char=? (read-char) #\a))
+                          (read-line)
+                          (let ((replacenoid "chicken enchilada"))
+                            (unread-char #\newline (current-input-port))
+                            (unread-string replacenoid (current-input-port))
+                            (pass-if "unread-string"
+                                     (string=? (read-line) replacenoid)))
+                          (pass-if "unread residue"
+                                   (string=? (read-line) "moon"))))
 
 ;;; non-blocking mode on a port.  create a pipe and set O_NONBLOCK on
 ;;; the reading end.  try to read a byte: should get EAGAIN or
@@ -594,13 +594,13 @@
        (r (car p)))
   (fcntl r F_SETFL (logior (fcntl r F_GETFL) O_NONBLOCK))
   (pass-if "non-blocking-I/O"
-          (catch 'system-error
-                 (lambda () (read-char r) #f)
-                 (lambda (key . args)
-                   (and (eq? key 'system-error)
-                        (let ((errno (car (list-ref args 3))))
-                          (or (= errno EAGAIN)
-                              (= errno EWOULDBLOCK))))))))
+           (catch 'system-error
+                  (lambda () (read-char r) #f)
+                  (lambda (key . args)
+                    (and (eq? key 'system-error)
+                         (let ((errno (car (list-ref args 3))))
+                           (or (= errno EAGAIN)
+                               (= errno EWOULDBLOCK))))))))
 
 
 ;;;; Pipe (popen) ports.
@@ -610,7 +610,7 @@
        (in-string (read-all pipe)))
   (close-pipe pipe)
   (pass-if "pipe: read"
-          (equal? in-string "Howdy there, partner!\n")))
+           (equal? in-string "Howdy there, partner!\n")))
 
 ;;; Run a command, send some output to it, and see if it worked.
 (let* ((filename (test-file))
@@ -620,9 +620,33 @@
   (close-pipe pipe)
   (let ((in-string (read-file filename)))
     (pass-if "pipe: write"
-            (equal? in-string "Mommy, why does everybody have a bomb?\n")))
+             (equal? in-string "Mommy, why does everybody have a bomb?\n")))
   (delete-file filename))
 
+(pass-if-equal "pipe, fdopen, and _IOLBF"
+    "foo\nbar\n"
+  (let ((in+out (pipe))
+        (pid    (primitive-fork)))
+    (if (zero? pid)
+        (dynamic-wind
+          (const #t)
+          (lambda ()
+            (close-port (car in+out))
+            (let ((port (cdr in+out)))
+              (setvbuf port _IOLBF )
+              ;; Strings containing '\n' or should be flushed; others
+              ;; should be kept in PORT's buffer.
+              (display "foo\n" port)
+              (display "bar\n" port)
+              (display "this will be kept in PORT's buffer" port)))
+          (lambda ()
+            (primitive-_exit 0)))
+        (begin
+          (close-port (cdr in+out))
+          (let ((str (read-all (car in+out))))
+            (waitpid pid)
+            str)))))
+
 
 ;;;; Void ports.  These are so trivial we don't test them.
 
@@ -633,70 +657,70 @@
 
   ;; Write text to a string port.
   (let* ((string "Howdy there, partner!")
-        (in-string (call-with-output-string
-                    (lambda (port)
-                      (display string port)
-                      (newline port)))))
+         (in-string (call-with-output-string
+                     (lambda (port)
+                       (display string port)
+                       (newline port)))))
     (pass-if "display text"
-            (equal? in-string (string-append string "\n"))))
-                  
+             (equal? in-string (string-append string "\n"))))
+
   ;; Write an s-expression to a string port.
   (let* ((sexpr '("more utterly random text" 1729 #(a vector) 3.1415926))
-        (in-sexpr 
-         (call-with-input-string (call-with-output-string
-                                  (lambda (port)
-                                    (write sexpr port)))
-                                 read)))
+         (in-sexpr
+          (call-with-input-string (call-with-output-string
+                                   (lambda (port)
+                                     (write sexpr port)))
+                                  read)))
     (pass-if "write/read sexpr"
-            (equal? in-sexpr sexpr)))
+             (equal? in-sexpr sexpr)))
 
   ;; seeking and unreading from an input string.
   (let ((text "that text didn't look random to me"))
     (call-with-input-string text
-                           (lambda (p)
-                             (pass-if "input tell 0"
-                                      (= (seek p 0 SEEK_CUR) 0))
-                             (read-char p)
-                             (pass-if "input tell 1"
-                                      (= (seek p 0 SEEK_CUR) 1))
-                             (unread-char #\x p)
-                             (pass-if "input tell back to 0"
-                                      (= (seek p 0 SEEK_CUR) 0))
-                             (pass-if "input ungetted char"
-                                      (char=? (read-char p) #\x))
-                             (seek p 0 SEEK_END)
-                             (pass-if "input seek to end"
-                                      (= (seek p 0 SEEK_CUR)
-                                         (string-length text)))
-                             (unread-char #\x p)
-                             (pass-if "input seek to beginning"
-                                      (= (seek p 0 SEEK_SET) 0))
-                             (pass-if "input reread first char"
-                                      (char=? (read-char p)
-                                              (string-ref text 0))))))
+                            (lambda (p)
+                              (pass-if "input tell 0"
+                                       (= (seek p 0 SEEK_CUR) 0))
+                              (read-char p)
+                              (pass-if "input tell 1"
+                                       (= (seek p 0 SEEK_CUR) 1))
+                              (unread-char #\x p)
+                              (pass-if "input tell back to 0"
+                                       (= (seek p 0 SEEK_CUR) 0))
+                              (pass-if "input ungetted char"
+                                       (char=? (read-char p) #\x))
+                              (seek p 0 SEEK_END)
+                              (pass-if "input seek to end"
+                                       (= (seek p 0 SEEK_CUR)
+                                          (string-length text)))
+                              (unread-char #\x p)
+                              (pass-if "input seek to beginning"
+                                       (= (seek p 0 SEEK_SET) 0))
+                              (pass-if "input reread first char"
+                                       (char=? (read-char p)
+                                               (string-ref text 0))))))
 
   ;; seeking an output string.
   (let* ((text (string-copy "123456789"))
-        (len (string-length text))
-        (result (call-with-output-string
-                 (lambda (p)
-                   (pass-if "output tell 0"
-                            (= (seek p 0 SEEK_CUR) 0))
-                   (display text p)
-                   (pass-if "output tell end"
-                            (= (seek p 0 SEEK_CUR) len))
-                   (pass-if "output seek to beginning"
-                            (= (seek p 0 SEEK_SET) 0))
-                   (write-char #\a p)
-                   (seek p -1 SEEK_END)
-                   (pass-if "output seek to last char"
-                            (= (seek p 0 SEEK_CUR)
-                               (- len 1)))
-                   (write-char #\b p)))))
+         (len (string-length text))
+         (result (call-with-output-string
+                  (lambda (p)
+                    (pass-if "output tell 0"
+                             (= (seek p 0 SEEK_CUR) 0))
+                    (display text p)
+                    (pass-if "output tell end"
+                             (= (seek p 0 SEEK_CUR) len))
+                    (pass-if "output seek to beginning"
+                             (= (seek p 0 SEEK_SET) 0))
+                    (write-char #\a p)
+                    (seek p -1 SEEK_END)
+                    (pass-if "output seek to last char"
+                             (= (seek p 0 SEEK_CUR)
+                                (- len 1)))
+                    (write-char #\b p)))))
     (string-set! text 0 #\a)
     (string-set! text (- len 1) #\b)
     (pass-if "output check"
-            (string=? text result)))
+             (string=? text result)))
 
   (pass-if "%default-port-encoding is ignored"
     (let ((str "ĉu bone?"))
@@ -936,17 +960,17 @@
   ;; Return a list of input ports that all return the same text.
   ;; We map tests over this list.
   (define (input-port-list text)
-    
+
     ;; Create a text file some of the ports will use.
     (let ((out-port (open-output-file port-loop-temp)))
       (display text out-port)
       (close-port out-port))
 
     (list (open-input-file port-loop-temp)
-         (open-input-pipe (string-append "cat " port-loop-temp))
-         (call-with-input-string text (lambda (x) x))
-         ;; We don't test soft ports at the moment.
-         ))
+          (open-input-pipe (string-append "cat " port-loop-temp))
+          (call-with-input-string text (lambda (x) x))
+          ;; We don't test soft ports at the moment.
+          ))
 
   (define port-list-names '("file" "pipe" "string"))
 
@@ -954,55 +978,55 @@
   (define (test-line-counter text second-line final-column)
     (with-test-prefix "line counter"
       (let ((ports (input-port-list text)))
-       (for-each
-        (lambda (port port-name)
-          (with-test-prefix port-name
-            (pass-if "at beginning of input"
-                     (= (port-line port) 0))
-            (pass-if "read first character"
-                     (eqv? (read-char port) #\x))
-            (pass-if "after reading one character"
-                     (= (port-line port) 0))
-            (pass-if "read first newline"
-                     (eqv? (read-char port) #\newline))
-            (pass-if "after reading first newline char"
-                     (= (port-line port) 1))
-            (pass-if "second line read correctly"
-                     (equal? (read-line port) second-line))
-            (pass-if "read-line increments line number"
-                     (= (port-line port) 2))
-            (pass-if "read-line returns EOF"
-                     (let loop ((i 0))
-                       (cond
-                        ((eof-object? (read-line port)) #t)
-                        ((> i 20) #f)
-                        (else (loop (+ i 1))))))
-            (pass-if "line count is 5 at EOF"
-                     (= (port-line port) 5))
-            (pass-if "column is correct at EOF"
-                     (= (port-column port) final-column))))
-        ports port-list-names)
-       (for-each close-port ports)
-       (delete-file port-loop-temp))))
+        (for-each
+         (lambda (port port-name)
+           (with-test-prefix port-name
+             (pass-if "at beginning of input"
+                      (= (port-line port) 0))
+             (pass-if "read first character"
+                      (eqv? (read-char port) #\x))
+             (pass-if "after reading one character"
+                      (= (port-line port) 0))
+             (pass-if "read first newline"
+                      (eqv? (read-char port) #\newline))
+             (pass-if "after reading first newline char"
+                      (= (port-line port) 1))
+             (pass-if "second line read correctly"
+                      (equal? (read-line port) second-line))
+             (pass-if "read-line increments line number"
+                      (= (port-line port) 2))
+             (pass-if "read-line returns EOF"
+                      (let loop ((i 0))
+                        (cond
+                         ((eof-object? (read-line port)) #t)
+                         ((> i 20) #f)
+                         (else (loop (+ i 1))))))
+             (pass-if "line count is 5 at EOF"
+                      (= (port-line port) 5))
+             (pass-if "column is correct at EOF"
+                      (= (port-column port) final-column))))
+         ports port-list-names)
+        (for-each close-port ports)
+        (delete-file port-loop-temp))))
 
   (with-test-prefix "newline"
     (test-line-counter
      (string-append "x\n"
-                   "He who receives an idea from me, receives instruction\n"
-                   "himself without lessening mine; as he who lights his\n"
-                   "taper at mine, receives light without darkening me.\n"
-                   "  --- Thomas Jefferson\n")
+                    "He who receives an idea from me, receives instruction\n"
+                    "himself without lessening mine; as he who lights his\n"
+                    "taper at mine, receives light without darkening me.\n"
+                    "  --- Thomas Jefferson\n")
      "He who receives an idea from me, receives instruction"
      0))
 
   (with-test-prefix "no newline"
     (test-line-counter
      (string-append "x\n"
-                   "He who receives an idea from me, receives instruction\n"
-                   "himself without lessening mine; as he who lights his\n"
-                   "taper at mine, receives light without darkening me.\n"
-                   "  --- Thomas Jefferson\n"
-                   "no newline here")
+                    "He who receives an idea from me, receives instruction\n"
+                    "himself without lessening mine; as he who lights his\n"
+                    "taper at mine, receives light without darkening me.\n"
+                    "  --- Thomas Jefferson\n"
+                    "no newline here")
      "He who receives an idea from me, receives instruction"
      15)))
 
@@ -1012,28 +1036,28 @@
   (with-test-prefix "port-line and port-column for output ports"
     (let ((port (open-output-string)))
       (pass-if "at beginning of input"
-              (and (= (port-line port) 0)
-                   (= (port-column port) 0)))
+               (and (= (port-line port) 0)
+                    (= (port-column port) 0)))
       (write-char #\x port)
       (pass-if "after writing one character"
-              (and (= (port-line port) 0)
-                   (= (port-column port) 1)))
+               (and (= (port-line port) 0)
+                    (= (port-column port) 1)))
       (write-char #\newline port)
       (pass-if "after writing first newline char"
-              (and (= (port-line port) 1)
-                   (= (port-column port) 0)))
+               (and (= (port-line port) 1)
+                    (= (port-column port) 0)))
       (display text port)
       (pass-if "line count is 5 at end"
-              (= (port-line port) 5))
+               (= (port-line port) 5))
       (pass-if "column is correct at end"
-              (= (port-column port) final-column)))))
+               (= (port-column port) final-column)))))
 
 (test-output-line-counter
  (string-append "He who receives an idea from me, receives instruction\n"
-               "himself without lessening mine; as he who lights his\n"
-               "taper at mine, receives light without darkening me.\n"
-               "  --- Thomas Jefferson\n"
-               "no newline here")
+                "himself without lessening mine; as he who lights his\n"
+                "taper at mine, receives light without darkening me.\n"
+                "  --- Thomas Jefferson\n"
+                "no newline here")
  15)
 
 (with-test-prefix "port-column"
@@ -1042,115 +1066,115 @@
 
     (pass-if "x"
       (let ((port (open-output-string)))
-       (display "x" port)
-       (= 1 (port-column port))))
+        (display "x" port)
+        (= 1 (port-column port))))
 
     (pass-if "\\a"
       (let ((port (open-output-string)))
-       (display "\a" port)
-       (= 0 (port-column port))))
+        (display "\a" port)
+        (= 0 (port-column port))))
 
     (pass-if "x\\a"
       (let ((port (open-output-string)))
-       (display "x\a" port)
-       (= 1 (port-column port))))
+        (display "x\a" port)
+        (= 1 (port-column port))))
 
     (pass-if "\\x08 backspace"
       (let ((port (open-output-string)))
-       (display "\x08" port)
-       (= 0 (port-column port))))
+        (display "\x08" port)
+        (= 0 (port-column port))))
 
     (pass-if "x\\x08 backspace"
       (let ((port (open-output-string)))
-       (display "x\x08" port)
-       (= 0 (port-column port))))
+        (display "x\x08" port)
+        (= 0 (port-column port))))
 
     (pass-if "\\n"
       (let ((port (open-output-string)))
-       (display "\n" port)
-       (= 0 (port-column port))))
+        (display "\n" port)
+        (= 0 (port-column port))))
 
     (pass-if "x\\n"
       (let ((port (open-output-string)))
-       (display "x\n" port)
-       (= 0 (port-column port))))
+        (display "x\n" port)
+        (= 0 (port-column port))))
 
     (pass-if "\\r"
       (let ((port (open-output-string)))
-       (display "\r" port)
-       (= 0 (port-column port))))
+        (display "\r" port)
+        (= 0 (port-column port))))
 
     (pass-if "x\\r"
       (let ((port (open-output-string)))
-       (display "x\r" port)
-       (= 0 (port-column port))))
+        (display "x\r" port)
+        (= 0 (port-column port))))
 
     (pass-if "\\t"
       (let ((port (open-output-string)))
-       (display "\t" port)
-       (= 8 (port-column port))))
+        (display "\t" port)
+        (= 8 (port-column port))))
 
     (pass-if "x\\t"
       (let ((port (open-output-string)))
-       (display "x\t" port)
-       (= 8 (port-column port)))))
+        (display "x\t" port)
+        (= 8 (port-column port)))))
 
   (with-test-prefix "input"
 
     (pass-if "x"
       (let ((port (open-input-string "x")))
-       (while (not (eof-object? (read-char port))))
-       (= 1 (port-column port))))
+        (while (not (eof-object? (read-char port))))
+        (= 1 (port-column port))))
 
     (pass-if "\\a"
       (let ((port (open-input-string "\a")))
-       (while (not (eof-object? (read-char port))))
-       (= 0 (port-column port))))
+        (while (not (eof-object? (read-char port))))
+        (= 0 (port-column port))))
 
     (pass-if "x\\a"
       (let ((port (open-input-string "x\a")))
-       (while (not (eof-object? (read-char port))))
-       (= 1 (port-column port))))
+        (while (not (eof-object? (read-char port))))
+        (= 1 (port-column port))))
 
     (pass-if "\\x08 backspace"
       (let ((port (open-input-string "\x08")))
-       (while (not (eof-object? (read-char port))))
-       (= 0 (port-column port))))
+        (while (not (eof-object? (read-char port))))
+        (= 0 (port-column port))))
 
     (pass-if "x\\x08 backspace"
       (let ((port (open-input-string "x\x08")))
-       (while (not (eof-object? (read-char port))))
-       (= 0 (port-column port))))
+        (while (not (eof-object? (read-char port))))
+        (= 0 (port-column port))))
 
     (pass-if "\\n"
       (let ((port (open-input-string "\n")))
-       (while (not (eof-object? (read-char port))))
-       (= 0 (port-column port))))
+        (while (not (eof-object? (read-char port))))
+        (= 0 (port-column port))))
 
     (pass-if "x\\n"
       (let ((port (open-input-string "x\n")))
-       (while (not (eof-object? (read-char port))))
-       (= 0 (port-column port))))
+        (while (not (eof-object? (read-char port))))
+        (= 0 (port-column port))))
 
     (pass-if "\\r"
       (let ((port (open-input-string "\r")))
-       (while (not (eof-object? (read-char port))))
-       (= 0 (port-column port))))
+        (while (not (eof-object? (read-char port))))
+        (= 0 (port-column port))))
 
     (pass-if "x\\r"
       (let ((port (open-input-string "x\r")))
-       (while (not (eof-object? (read-char port))))
-       (= 0 (port-column port))))
+        (while (not (eof-object? (read-char port))))
+        (= 0 (port-column port))))
 
     (pass-if "\\t"
       (let ((port (open-input-string "\t")))
-       (while (not (eof-object? (read-char port))))
-       (= 8 (port-column port))))
+        (while (not (eof-object? (read-char port))))
+        (= 8 (port-column port))))
 
     (pass-if "x\\t"
       (let ((port (open-input-string "x\t")))
-       (while (not (eof-object? (read-char port))))
-       (= 8 (port-column port))))))
+        (while (not (eof-object? (read-char port))))
+        (= 8 (port-column port))))))
 
 (with-test-prefix "port-line"
 
@@ -1159,7 +1183,7 @@
   ;; systems
   (pass-if "set most-positive-fixnum/2"
     (let ((n    (quotient most-positive-fixnum 2))
-         (port (open-output-string)))
+          (port (open-output-string)))
       (set-port-line! port n)
       (eqv? n (port-line port)))))
 
@@ -1205,7 +1229,7 @@
       (gc)
       ;; but they're still in the port table, so this sees them
       (port-for-each (lambda (port)
-                      (set! lst (cons port lst))))
+                       (set! lst (cons port lst))))
       ;; this forces completion of the sweeping
       (gc) (gc) (gc)
       ;; and (if the bug is present) the cells accumulated in LST are now
@@ -1215,9 +1239,10 @@
 (with-test-prefix
  "fdes->port"
  (pass-if "fdes->ports finds port"
-         (let ((port (open-file (test-file) "w")))
-
-           (not (not (memq port (fdes->ports (port->fdes port))))))))
+          (let* ((port (open-file (test-file) "w"))
+                 (res (not (not (memq port (fdes->ports (port->fdes port)))))))
+            (close-port port)
+            res)))
 
 ;;;
 ;;; seek
@@ -1229,30 +1254,36 @@
 
     (pass-if "SEEK_CUR"
       (call-with-output-file (test-file)
-       (lambda (port)
-         (display "abcde" port)))
+        (lambda (port)
+          (display "abcde" port)))
       (let ((port (open-file (test-file) "r")))
-       (read-char port)
-       (seek port 2 SEEK_CUR)
-       (eqv? #\d (read-char port))))
+        (read-char port)
+        (seek port 2 SEEK_CUR)
+        (let ((res (eqv? #\d (read-char port))))
+          (close-port port)
+          res)))
 
     (pass-if "SEEK_SET"
       (call-with-output-file (test-file)
-       (lambda (port)
-         (display "abcde" port)))
+        (lambda (port)
+          (display "abcde" port)))
       (let ((port (open-file (test-file) "r")))
-       (read-char port)
-       (seek port 3 SEEK_SET)
-       (eqv? #\d (read-char port))))
+        (read-char port)
+        (seek port 3 SEEK_SET)
+        (let ((res (eqv? #\d (read-char port))))
+          (close-port port)
+          res)))
 
     (pass-if "SEEK_END"
       (call-with-output-file (test-file)
-       (lambda (port)
-         (display "abcde" port)))
+        (lambda (port)
+          (display "abcde" port)))
       (let ((port (open-file (test-file) "r")))
-       (read-char port)
-       (seek port -2 SEEK_END)
-       (eqv? #\d (read-char port))))))
+        (read-char port)
+        (seek port -2 SEEK_END)
+        (let ((res (eqv? #\d (read-char port))))
+          (close-port port)
+          res)))))
 
 ;;;
 ;;; truncate-file
@@ -1270,61 +1301,63 @@
 
     (pass-if-exception "flonum length" exception:wrong-type-arg
       (call-with-output-file (test-file)
-       (lambda (port)
-         (display "hello" port)))
+        (lambda (port)
+          (display "hello" port)))
       (truncate-file (test-file) 1.0))
 
     (pass-if "shorten"
       (call-with-output-file (test-file)
-       (lambda (port)
-         (display "hello" port)))
+        (lambda (port)
+          (display "hello" port)))
       (truncate-file (test-file) 1)
       (eqv? 1 (stat:size (stat (test-file)))))
 
     (pass-if-exception "shorten to current pos" exception:miscellaneous-error
       (call-with-output-file (test-file)
-       (lambda (port)
-         (display "hello" port)))
+        (lambda (port)
+          (display "hello" port)))
       (truncate-file (test-file))))
 
   (with-test-prefix "file descriptor"
 
     (pass-if "shorten"
       (call-with-output-file (test-file)
-       (lambda (port)
-         (display "hello" port)))
+        (lambda (port)
+          (display "hello" port)))
       (let ((fd (open-fdes (test-file) O_RDWR)))
-       (truncate-file fd 1)
-       (close-fdes fd))
+        (truncate-file fd 1)
+        (close-fdes fd))
       (eqv? 1 (stat:size (stat (test-file)))))
 
     (pass-if "shorten to current pos"
       (call-with-output-file (test-file)
-       (lambda (port)
-         (display "hello" port)))
+        (lambda (port)
+          (display "hello" port)))
       (let ((fd (open-fdes (test-file) O_RDWR)))
-       (seek fd 1 SEEK_SET)
-       (truncate-file fd)
-       (close-fdes fd))
+        (seek fd 1 SEEK_SET)
+        (truncate-file fd)
+        (close-fdes fd))
       (eqv? 1 (stat:size (stat (test-file))))))
 
   (with-test-prefix "file port"
 
     (pass-if "shorten"
       (call-with-output-file (test-file)
-       (lambda (port)
-         (display "hello" port)))
+        (lambda (port)
+          (display "hello" port)))
       (let ((port (open-file (test-file) "r+")))
-       (truncate-file port 1))
+        (truncate-file port 1)
+        (close-port port))
       (eqv? 1 (stat:size (stat (test-file)))))
 
     (pass-if "shorten to current pos"
       (call-with-output-file (test-file)
-       (lambda (port)
-         (display "hello" port)))
+        (lambda (port)
+          (display "hello" port)))
       (let ((port (open-file (test-file) "r+")))
-       (read-char port)
-       (truncate-file port))
+        (read-char port)
+        (truncate-file port)
+        (close-port port))
       (eqv? 1 (stat:size (stat (test-file)))))))
 
 
@@ -1332,17 +1365,17 @@
 
 (with-test-prefix "read-delimited!"
   (let ((c (make-string 20 #\!)))
-    (call-with-input-string 
+    (call-with-input-string
      "defdef\nghighi\n"
      (lambda (port)
-       
+
        (read-delimited! "\n" c port 'concat)
        (pass-if "read-delimited! reads a first line"
-               (string=? c "defdef\n!!!!!!!!!!!!!"))
+                (string=? c "defdef\n!!!!!!!!!!!!!"))
 
        (read-delimited! "\n" c port 'concat 3)
        (pass-if "read-delimited! reads a first line"
-               (string=? c "defghighi\n!!!!!!!!!!"))))))
+                (string=? c "defghighi\n!!!!!!!!!!"))))))
 
 
 ;;;; char-ready?
@@ -1351,7 +1384,7 @@
  "howdy"
  (lambda (port)
    (pass-if "char-ready? returns true on string port"
-           (char-ready? port))))
+            (char-ready? port))))
 
 ;;; This segfaults on some versions of Guile.  We really should run
 ;;; the tests in a subprocess...
@@ -1363,7 +1396,7 @@
        port
      (lambda ()
        (pass-if "char-ready? returns true on string port as default port"
-               (char-ready?))))))
+                (char-ready?))))))
 
 
 ;;;; pending-eof behavior
@@ -1454,15 +1487,15 @@
 
 (with-test-prefix "closing current-input-port"
   (for-each (lambda (procedure name)
-             (with-input-from-port
-                 (call-with-input-string "foo" (lambda (p) p))
-               (lambda ()
-                 (close-port (current-input-port))
-                 (pass-if-exception name
-                   exception:wrong-type-arg
-                   (procedure)))))
-           (list read read-char read-line)
-           '("read" "read-char" "read-line")))
+              (with-input-from-port
+                  (call-with-input-string "foo" (lambda (p) p))
+                (lambda ()
+                  (close-port (current-input-port))
+                  (pass-if-exception name
+                    exception:wrong-type-arg
+                    (procedure)))))
+            (list read read-char read-line)
+            '("read" "read-char" "read-line")))
 
 
 
@@ -1824,6 +1857,17 @@
     (with-fluids ((%file-port-name-canonicalization 'absolute))
       (port-filename (open-input-file (%search-load-path "ice-9/q.scm"))))))
 
+(with-test-prefix "file name separators"
+
+  (pass-if "no backslash separators in Windows file names"
+    ;; In Guile 2.0.11 and earlier, %load-path on Windows could
+    ;; include file names with backslashes, and `getcwd' on Windows
+    ;; would always return a directory name with backslashes.
+    (or (not (file-name-separator? #\\))
+        (with-load-path (cons (getcwd) %load-path)
+          (not (string-index (%search-load-path (basename (test-file)))
+                             #\\))))))
+
 (delete-file (test-file))
 
 ;;; Local Variables:
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index 00e9c68..9a0e489 100644
--- a/test-suite/tests/posix.test
+++ b/test-suite/tests/posix.test
@@ -70,9 +70,10 @@
 
   (pass-if "filename string modified"
     (let* ((template "T-XXXXXX")
-          (str      (string-copy template))
-          (port     (mkstemp! str))
-          (result   (not (string=? str template))))
+           (str      (string-copy template))
+           (port     (mkstemp! str))
+           (result   (not (string=? str template))))
+      (close-port port)
       (delete-file str)
       result)))
 
diff --git a/test-suite/tests/r6rs-files.test b/test-suite/tests/r6rs-files.test
index df5dd22..9b31a82 100644
--- a/test-suite/tests/r6rs-files.test
+++ b/test-suite/tests/r6rs-files.test
@@ -24,7 +24,9 @@
 
 (with-test-prefix "delete-file"
   (pass-if "delete-file deletes file"
-    (let ((filename (port-filename (mkstemp! "T-XXXXXX"))))
+    (let* ((port (mkstemp! "T-XXXXXX"))
+           (filename (port-filename port)))
+      (close-port port)
       (delete-file filename)
       (not (file-exists? filename))))
 
@@ -32,9 +34,9 @@
     (let ((success #f))
       (call/cc
        (lambda (continuation)
-        (with-exception-handler
-         (lambda (condition)
-           (set! success (i/o-filename-error? condition))
-           (continuation))
-         (lambda () (delete-file "")))))
+         (with-exception-handler
+          (lambda (condition)
+            (set! success (i/o-filename-error? condition))
+            (continuation))
+          (lambda () (delete-file "")))))
       success)))
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index b0ffa76..17acdc4 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -137,6 +137,26 @@
       (close-port port)
       (get-bytevector-n port 3)))
 
+  (let ((expected (make-bytevector 20 (char->integer #\a))))
+    (pass-if-equal "http://bugs.gnu.org/17466";
+        ;; <http://bugs.gnu.org/17466> is about a memory corruption
+        ;; whereas bytevector shrunk in 'get-bytevector-n' would keep
+        ;; referring to the previous (larger) bytevector.
+        expected
+      (let loop ((count 50))
+        (if (zero? count)
+            expected
+            (let ((bv (call-with-input-string "aaaaaaaaaaaaaaaaaaaa"
+                        (lambda (port)
+                          (get-bytevector-n port 4096)))))
+              ;; Cause the 4 KiB bytevector initially created by
+              ;; 'get-bytevector-n' to be reclaimed.
+              (make-bytevector 4096)
+
+              (if (equal? bv expected)
+                  (loop (- count 1))
+                  bv))))))
+
   (pass-if "get-bytevector-n! [short]"
     (let* ((port (open-input-string "GNU Guile"))
            (bv   (make-bytevector 4))
diff --git a/test-suite/tests/rdelim.test b/test-suite/tests/rdelim.test
index 437a0ee..617e651 100644
--- a/test-suite/tests/rdelim.test
+++ b/test-suite/tests/rdelim.test
@@ -1,7 +1,7 @@
 ;;;; rdelim.test --- Delimited I/O.      -*- mode: scheme; coding: utf-8; -*-
 ;;;; Ludovic Courtès <address@hidden>
 ;;;;
-;;;;   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
@@ -207,7 +207,13 @@
     (let* ((s (string-concatenate (make-list 20 "hello, world!")))
            (p (open-input-string s)))
       (and (string=? (read-string p) s)
-           (string=? (read-string p) "")))))
+           (string=? (read-string p) ""))))
+
+  (pass-if-equal "longer than 100 chars, with limit"
+      "hello, world!"
+    (let* ((s (string-concatenate (make-list 20 "hello, world!")))
+           (p (open-input-string s)))
+      (read-string p 13))))
 
 (with-test-prefix "read-string!"
 
diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test
index d40f8e1..bce0e86 100644
--- a/test-suite/tests/srfi-1.test
+++ b/test-suite/tests/srfi-1.test
@@ -1,6 +1,6 @@
 ;;;; srfi-1.test --- Test suite for Guile's SRFI-1 functions. -*- scheme -*-
 ;;;;
-;;;; Copyright 2003, 2004, 2005, 2006, 2008, 2009, 2010, 2011 Free Software 
Foundation, Inc.
+;;;; Copyright 2003-2006, 2008-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
@@ -1329,6 +1329,10 @@
     (length+))
   (pass-if-exception "too many args" exception:wrong-num-args
     (length+ 123 456))
+  (pass-if-exception "not a pair" exception:wrong-type-arg
+    (length+ 'x))
+  (pass-if-exception "improper list" exception:wrong-type-arg
+    (length+ '(x y . z)))
   (pass-if (= 0 (length+ '())))
   (pass-if (= 1 (length+ '(x))))
   (pass-if (= 2 (length+ '(x y))))
diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test
index 8178120..3b7a3e4 100644
--- a/test-suite/tests/threads.test
+++ b/test-suite/tests/threads.test
@@ -1,6 +1,7 @@
 ;;;; threads.test --- Tests for Guile threading.    -*- scheme -*-
 ;;;;
-;;;; Copyright 2003, 2006, 2007, 2009, 2010, 2011, 2012, 2013 Free Software 
Foundation, Inc.
+;;;; Copyright 2003, 2006, 2007, 2009, 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
@@ -36,6 +37,11 @@
     (equal? '(a b c) '(a b c))
     a))
 
+(define (require-cancel-thread)
+  ;; Skip the test when 'cancel-thread' is unavailable.
+  (unless (defined? 'cancel-thread)
+    (throw 'unresolved)))
+
 (if (provided? 'threads)
     (begin
 
@@ -277,6 +283,7 @@
       (with-test-prefix "join-thread"
 
        (pass-if "timed joining fails if timeout exceeded"
+          (require-cancel-thread)
          (let* ((m (make-mutex))
                 (c (make-condition-variable))
                 (t (begin-thread (begin (lock-mutex m)
@@ -286,6 +293,7 @@
            (not r)))
 
         (pass-if "join-thread returns timeoutval on timeout"
+          (require-cancel-thread)
           (let* ((m (make-mutex))
                 (c (make-condition-variable))
                 (t (begin-thread (begin (lock-mutex m)
@@ -335,6 +343,7 @@
       (with-test-prefix "cancel-thread"
 
         (pass-if "cancel succeeds"
+          (require-cancel-thread)
          (let ((m (make-mutex)))
            (lock-mutex m)
            (let ((t (begin-thread (begin (lock-mutex m) 'foo))))
@@ -343,6 +352,7 @@
              #t)))
 
        (pass-if "handler result passed to join"
+          (require-cancel-thread)
          (let ((m (make-mutex)))
            (lock-mutex m)
            (let ((t (begin-thread (lock-mutex m))))
@@ -351,6 +361,7 @@
              (eq? (join-thread t) 'foo))))
 
        (pass-if "can cancel self"
+          (require-cancel-thread)
          (let ((m (make-mutex)))
            (lock-mutex m)
            (let ((t (begin-thread (begin
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 0f6d945..d52a642 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -1,8 +1,7 @@
 ;;;; tree-il.test --- test suite for compiling tree-il   -*- scheme -*-
 ;;;; Andy Wingo <address@hidden> --- May 2009
 ;;;;
-;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013,
-;;;;   2014 Free Software Foundation, Inc.
+;;;; Copyright (C) 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
@@ -1132,6 +1131,50 @@
               (number? (string-contains (car w)
                                         "expected 3, got 2")))))
 
+     (pass-if "~p"
+       (null? (call-with-warnings
+               (lambda ()
+                 (compile '(((@ (ice-9 format) format) #f "thing~p" 2))
+                          #:opts %opts-w-format
+                          #:to 'cps)))))
+
+     (pass-if "~p, too few arguments"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '((@ (ice-9 format) format) #f "~p")
+                            #:opts %opts-w-format
+                            #:to 'cps)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "expected 1, got 0")))))
+
+     (pass-if "~:p"
+       (null? (call-with-warnings
+               (lambda ()
+                 (compile '(((@ (ice-9 format) format) #f "~d thing~:p" 2))
+                          #:opts %opts-w-format
+                          #:to 'cps)))))
+
+     (pass-if "~:@p, too many arguments"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '((@ (ice-9 format) format) #f "~d pupp~:@p" 5 5)
+                            #:opts %opts-w-format
+                            #:to 'cps)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "expected 1, got 2")))))
+
+     (pass-if "~:@p, too few arguments"
+       (let ((w (call-with-warnings
+                 (lambda ()
+                   (compile '((@ (ice-9 format) format) #f "pupp~:@p")
+                            #:opts %opts-w-format
+                            #:to 'cps)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w)
+                                        "expected 1, got 0")))))
+
      (pass-if "~?"
        (null? (call-with-warnings
                (lambda ()
@@ -1202,8 +1245,7 @@
        (let ((w (call-with-warnings
                  (lambda ()
                    (let ((in (open-input-string
-                              "(use-modules ((ice-9 format)
-                                 #:renamer (symbol-prefix-proc 'i9-)))
+                              "(use-modules ((ice-9 format) #:prefix i9-))
                                (i9-format #t \"yo! ~A\" 1 2)")))
                      (read-and-compile in
                                        #:opts %opts-w-format


hooks/post-receive
-- 
GNU Guile



reply via email to

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