[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-227-g86faf
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-227-g86fafc4 |
|
Date: |
Fri, 22 Mar 2013 21:24:39 +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=86fafc440220b0ab1d76439e89ac8114a9c7660d
The branch, stable-2.0 has been updated
via 86fafc440220b0ab1d76439e89ac8114a9c7660d (commit)
via fbac7c6113056bc6ee85996b10bdc08325c742a5 (commit)
via e8a57fb052c4d9c27681183bd0cf2be31142d58a (commit)
via 43c2a48323803e9aae41ba896ce6b6a0067343ad (commit)
from c5c7c1146f2488f92b11b1edbe36fa99ffdf2771 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 86fafc440220b0ab1d76439e89ac8114a9c7660d
Author: Ludovic Courtès <address@hidden>
Date: Fri Mar 22 22:24:27 2013 +0100
tests: Add more `maybe-gc-flakiness'.
Fixes <http://bugs.gnu.org/14001>.
Reported by Dennis Clarke <address@hidden>.
* test-suite/tests/gc.test ("gc")["Lexical vars are collectable"]: Wrap
in `maybe-gc-flakiness'.
commit fbac7c6113056bc6ee85996b10bdc08325c742a5
Author: Ludovic Courtès <address@hidden>
Date: Wed Mar 20 23:04:11 2013 +0100
Add bindings for `sendfile'.
* configure.ac: Check for <sys/sendfile.h> and `sendfile'.
* libguile/filesys.c (scm_sendfile): New function.
* libguile/filesys.h (scm_sendfile): New declaration.
* test-suite/tests/filesys.test ("sendfile"): New test prefix.
* doc/ref/posix.texi (File System): Document `sendfile'.
commit e8a57fb052c4d9c27681183bd0cf2be31142d58a
Author: Ludovic Courtès <address@hidden>
Date: Fri Mar 22 22:09:05 2013 +0100
texinfo plain-text: Use `match' for `stexi->plain-text'.
* module/texinfo/plain-text.scm (def)[list/spaces]: Remove.
(stexi->plain-text): Use `match' instead of `cond'.
commit 43c2a48323803e9aae41ba896ce6b6a0067343ad
Author: Ludovic Courtès <address@hidden>
Date: Fri Mar 22 22:05:23 2013 +0100
texinfo: Add whitespace after periods.
* module/texinfo/string-utils.scm (end-of-sentence?): New procedure.
(make-text-wrapper): Append an extra space after LINE when it matches
`end-of-sentence?' and COLLAPSE-WHITESPACE? is false.
* test-suite/tests/texinfo.serialize.test ("test-serialize"): Adjust
accordingly.
* test-suite/tests/texinfo.string-utils.test ("text wrapping")["two
spaces after end of sentence"]: New test prefix.
-----------------------------------------------------------------------
Summary of changes:
configure.ac | 20 +++++-
doc/ref/posix.texi | 23 +++++++
libguile/filesys.c | 91 ++++++++++++++++++++++++++++
libguile/filesys.h | 4 +-
module/texinfo/plain-text.scm | 34 ++++------
module/texinfo/string-utils.scm | 15 ++++-
test-suite/tests/filesys.test | 70 +++++++++++++++++++++-
test-suite/tests/gc.test | 4 +-
test-suite/tests/texinfo.serialize.test | 4 +-
test-suite/tests/texinfo.string-utils.test | 9 +++-
10 files changed, 240 insertions(+), 34 deletions(-)
diff --git a/configure.ac b/configure.ac
index 42de733..bcfc1a6 100644
--- a/configure.ac
+++ b/configure.ac
@@ -647,12 +647,13 @@ AC_SUBST([SCM_I_GSC_HAVE_STRUCT_DIRENT64])
# this file instead of <fenv.h>
# process.h - mingw specific
# sched.h - missing on MinGW
+# sys/sendfile.h - non-POSIX, found in glibc
#
AC_CHECK_HEADERS([complex.h fenv.h io.h libc.h limits.h memory.h process.h
string.h \
sys/dir.h sys/ioctl.h sys/select.h \
sys/time.h sys/timeb.h sys/times.h sys/stdtypes.h sys/types.h \
sys/utime.h time.h unistd.h utime.h pwd.h grp.h sys/utsname.h \
-direct.h machine/fpu.h sched.h])
+direct.h machine/fpu.h sched.h sys/sendfile.h])
# "complex double" is new in C99, and "complex" is only a keyword if
# <complex.h> is included
@@ -744,10 +745,21 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
# _NSGetEnviron - Darwin specific
# strcoll_l, newlocale - GNU extensions (glibc), also available on Darwin
# fork - unavailable on Windows
-# utimensat: posix.1-2008
-# sched_getaffinity, sched_setaffinity: GNU extensions (glibc)
+# utimensat - posix.1-2008
+# sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
+# sendfile - non-POSIX, found in glibc
#
-AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround
ftime ftruncate fchown fchmod getcwd geteuid getsid gettimeofday gmtime_r ioctl
lstat mkdir mknod nice pipe _pipe readdir_r readdir64_r readlink rename rmdir
select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64
strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid
strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent
kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy
rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale
utimensat sched_getaffinity sched_setaffinity])
+AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid
\
+ fesetround ftime ftruncate fchown fchmod getcwd geteuid getsid \
+ gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe
\
+ readdir_r readdir64_r readlink rename rmdir select setegid seteuid \
+ setlocale setpgid setsid sigaction siginterrupt stat64 strftime \
+ strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid
\
+ strdup system usleep atexit on_exit chown link fcntl ttyname getpwent
\
+ getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp \
+ index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron \
+ strcoll strcoll_l newlocale utimensat sched_getaffinity \
+ sched_setaffinity sendfile])
AM_CONDITIONAL([HAVE_FORK], [test "x$ac_cv_func_fork" = "xyes"])
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index ded3787..bc87329 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -803,6 +803,29 @@ Copy the file specified by @var{oldfile} to @var{newfile}.
The return value is unspecified.
@end deffn
address@hidden {Scheme Procedure} sendfile out in count [offset]
address@hidden {C Function} scm_sendfile (out, in, count, offset)
+Send @var{count} bytes from @var{in} to @var{out}, both of which
+are either open file ports or file descriptors. When
address@hidden is omitted, start reading from @var{in}'s current
+position; otherwise, start reading at @var{offset}.
+
+When @var{in} is a port, it is often preferable to specify @var{offset},
+because @var{in}'s offset as a port may be different from the offset of
+its underlying file descriptor.
+
+On systems that support it, such as GNU/Linux, this procedure uses the
address@hidden libc function, which usually corresponds to a system
+call. This is faster than doing a series of @code{read} and
address@hidden system calls. A typical application is to send a file over
+a socket.
+
+In some cases, the @code{sendfile} libc function may return
address@hidden or @code{ENOSYS}. In that case, Guile's @code{sendfile}
+procedure automatically falls back to doing a series of @code{read} and
address@hidden calls.
address@hidden deffn
+
@findex rename
@deffn {Scheme Procedure} rename-file oldname newname
@deffnx {C Function} scm_rename (oldname, newname)
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 282ff31..6804db9 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -98,6 +98,18 @@
#define NAMLEN(dirent) strlen ((dirent)->d_name)
+#ifdef HAVE_SYS_SENDFILE_H
+# include <sys/sendfile.h>
+#endif
+
+/* Glibc's `sendfile' function. */
+#define sendfile_or_sendfile64 \
+ CHOOSE_LARGEFILE (sendfile, sendfile64)
+
+#include <full-read.h>
+#include <full-write.h>
+
+
/* Some more definitions for the native Windows port. */
#ifdef __MINGW32__
# define fsync(fd) _commit (fd)
@@ -1096,6 +1108,85 @@ SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0,
+ (SCM out, SCM in, SCM count, SCM offset),
+ "Send @var{count} bytes from @var{in} to @var{out}, both of which "
+ "are either open file ports or file descriptors. When "
+ "@var{offset} is omitted, start reading from @var{in}'s current "
+ "position; otherwise, start reading at @var{offset}.")
+#define FUNC_NAME s_scm_sendfile
+{
+#define VALIDATE_FD_OR_PORT(cvar, svar, pos) \
+ if (scm_is_integer (svar)) \
+ cvar = scm_to_int (svar); \
+ else \
+ { \
+ SCM_VALIDATE_OPFPORT (pos, svar); \
+ scm_flush (svar); \
+ cvar = SCM_FPORT_FDES (svar); \
+ }
+
+ size_t c_count;
+ scm_t_off c_offset;
+ ssize_t result;
+ int in_fd, out_fd;
+
+ VALIDATE_FD_OR_PORT (out_fd, out, 1);
+ VALIDATE_FD_OR_PORT (in_fd, in, 2);
+ c_count = scm_to_size_t (count);
+ c_offset = SCM_UNBNDP (offset) ? 0 : scm_to_off_t (offset);
+
+#ifdef HAVE_SENDFILE
+ result = sendfile_or_sendfile64 (out_fd, in_fd,
+ SCM_UNBNDP (offset) ? NULL : &c_offset,
+ c_count);
+
+ /* Quoting the Linux man page: "In Linux kernels before 2.6.33, out_fd
+ must refer to a socket. Since Linux 2.6.33 it can be any file."
+ Fall back to read(2) and write(2) when such an error occurs. */
+ if (result < 0 && errno != EINVAL && errno != ENOSYS)
+ SCM_SYSERROR;
+ else if (result < 0)
+#endif
+ {
+ char buf[8192];
+ size_t result, left;
+
+ if (!SCM_UNBNDP (offset))
+ {
+ if (SCM_PORTP (in))
+ scm_seek (in, offset, scm_from_int (SEEK_SET));
+ else
+ lseek_or_lseek64 (in_fd, c_offset, SEEK_SET);
+ }
+
+ for (result = 0, left = c_count; result < c_count; )
+ {
+ size_t asked, obtained;
+
+ asked = SCM_MIN (sizeof buf, left);
+ obtained = full_read (in_fd, buf, asked);
+ if (obtained < asked)
+ SCM_SYSERROR;
+
+ left -= obtained;
+
+ obtained = full_write (out_fd, buf, asked);
+ if (obtained < asked)
+ SCM_SYSERROR;
+
+ result += obtained;
+ }
+
+ return scm_from_size_t (result);
+ }
+
+ return scm_from_ssize_t (result);
+
+#undef VALIDATE_FD_OR_PORT
+}
+#undef FUNC_NAME
+
#endif /* HAVE_POSIX */
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 967ce74..776b263 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -3,7 +3,8 @@
#ifndef SCM_FILESYS_H
#define SCM_FILESYS_H
-/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2010 Free
Software Foundation, Inc.
+/* Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2006, 2008, 2009,
+ * 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
@@ -66,6 +67,7 @@ SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile);
SCM_API SCM scm_dirname (SCM filename);
SCM_API SCM scm_basename (SCM filename, SCM suffix);
SCM_API SCM scm_canonicalize_path (SCM path);
+SCM_API SCM scm_sendfile (SCM out, SCM in, SCM count, SCM offset);
SCM_INTERNAL SCM scm_i_relativize_path (SCM path, SCM in_path);
SCM_INTERNAL void scm_init_filesys (void);
diff --git a/module/texinfo/plain-text.scm b/module/texinfo/plain-text.scm
index 3adaf04..809cdb7 100644
--- a/module/texinfo/plain-text.scm
+++ b/module/texinfo/plain-text.scm
@@ -31,6 +31,7 @@
#:use-module (sxml transform)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
+ #:use-module (ice-9 match)
#:export (stexi->plain-text))
;; The return value is a string.
@@ -95,13 +96,6 @@
(string-append "`" url "'"))))
(define (def tag args . body)
- (define (list/spaces . elts)
- (let lp ((in elts) (out '()))
- (cond ((null? in) (reverse! out))
- ((null? (car in)) (lp (cdr in) out))
- (else (lp (cdr in)
- (cons (car in)
- (if (null? out) out (cons " " out))))))))
(define (first-line)
(string-join
(filter identity
@@ -297,18 +291,18 @@
(define (stexi->plain-text tree)
"Transform @var{tree} into plain text. Returns a string."
- (cond
- ((null? tree) "")
- ((string? tree) tree)
- ((pair? tree)
- (cond
- ((symbol? (car tree))
- (let ((handler (and (not (ignored? (car tree)))
- (or (and=> (assq (car tree) tag-handlers) cadr)
- para))))
- (if handler (apply handler tree) "")))
- (else
- (string-concatenate (map-in-order stexi->plain-text tree)))))
- (else "")))
+ (match tree
+ (() "")
+ ((? string?) tree)
+ (((? symbol? tag) body ...)
+ (let ((handler (and (not (ignored? tag))
+ (or (and=> (assq tag tag-handlers) cadr)
+ para))))
+ (if handler
+ (apply handler tree)
+ "")))
+ ((tree ...)
+ (string-concatenate (map-in-order stexi->plain-text tree)))
+ (_ "")))
;;; arch-tag: f966c3f6-3b46-4790-bbf9-3ad27e4917c2
diff --git a/module/texinfo/string-utils.scm b/module/texinfo/string-utils.scm
index 7675149..22f969c 100644
--- a/module/texinfo/string-utils.scm
+++ b/module/texinfo/string-utils.scm
@@ -1,6 +1,6 @@
;;;; (texinfo string-utils) -- text filling and wrapping
;;;;
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2013 Free Software Foundation, Inc.
;;;; Copyright (C) 2003 Richard Todd
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -262,6 +262,13 @@ the default value for @var{num} is 1.
;; did not find non-ws... only ws at end of the string...
(reverse ans))))))
+(define (end-of-sentence? str)
+ "Return #t when STR likely denotes the end of sentence."
+ (let ((len (string-length str)))
+ (and (> len 1)
+ (eqv? #\. (string-ref str (- len 1)))
+ (not (eqv? #\. (string-ref str (- len 2)))))))
+
(define* (make-text-wrapper #:key
(line-width 80)
(expand-tabs? #t)
@@ -352,7 +359,11 @@ returns a list of strings, where each element of the list
is one line."
length-left)
(loop ans
(cdr words)
- (string-append line next-word)
+ (if (and collapse-whitespace?
+ (end-of-sentence? line))
+ ;; Add an extra space after the period.
+ (string-append line " " next-word)
+ (string-append line next-word))
(+ count 1)))
;; ok, it didn't fit...is there already at least one word on the
line?
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index a6bfb6e..c80c295 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -1,6 +1,6 @@
;;;; filesys.test --- test file system functions -*- scheme -*-
;;;;
-;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2006, 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
@@ -18,7 +18,10 @@
(define-module (test-suite test-filesys)
#:use-module (test-suite lib)
- #:use-module (test-suite guile-test))
+ #:use-module (test-suite guile-test)
+ #:use-module (ice-9 match)
+ #:use-module (rnrs io ports)
+ #:use-module (rnrs bytevectors))
(define (test-file)
(data-file-name "filesys-test.tmp"))
@@ -125,5 +128,68 @@
(close-port port)
(eqv? 5 (stat:size st))))))
+(with-test-prefix "sendfile"
+
+ (pass-if "file"
+ (let ((file (search-path %load-path "ice-9/boot-9.scm")))
+ (call-with-input-file file
+ (lambda (input)
+ (let ((len (stat:size (stat input))))
+ (call-with-output-file (test-file)
+ (lambda (output)
+ (sendfile output input len 0))))))
+ (let ((ref (call-with-input-file file get-bytevector-all))
+ (out (call-with-input-file (test-file) get-bytevector-all)))
+ (bytevector=? ref out))))
+
+ (pass-if "file with offset"
+ (let ((file (search-path %load-path "ice-9/boot-9.scm")))
+ (call-with-input-file file
+ (lambda (input)
+ (let ((len (stat:size (stat input))))
+ (call-with-output-file (test-file)
+ (lambda (output)
+ (sendfile output input (- len 777) 777))))))
+ (let ((ref (call-with-input-file file
+ (lambda (input)
+ (seek input 777 SEEK_SET)
+ (get-bytevector-all input))))
+ (out (call-with-input-file (test-file) get-bytevector-all)))
+ (bytevector=? ref out))))
+
+ (pass-if "pipe"
+ (let* ((file (search-path %load-path "ice-9/boot-9.scm"))
+ (in+out (pipe))
+ (child (call-with-new-thread
+ (lambda ()
+ (call-with-input-file file
+ (lambda (input)
+ (let ((len (stat:size (stat input))))
+ (sendfile (cdr in+out) (fileno input) len 0)
+ (close-port (cdr in+out)))))))))
+ (let ((ref (call-with-input-file file get-bytevector-all))
+ (out (get-bytevector-all (car in+out))))
+ (close-port (car in+out))
+ (bytevector=? ref out))))
+
+ (pass-if "pipe with offset"
+ (let* ((file (search-path %load-path "ice-9/boot-9.scm"))
+ (in+out (pipe))
+ (child (call-with-new-thread
+ (lambda ()
+ (call-with-input-file file
+ (lambda (input)
+ (let ((len (stat:size (stat input))))
+ (sendfile (cdr in+out) (fileno input)
+ (- len 777) 777)
+ (close-port (cdr in+out)))))))))
+ (let ((ref (call-with-input-file file
+ (lambda (input)
+ (seek input 777 SEEK_SET)
+ (get-bytevector-all input))))
+ (out (get-bytevector-all (car in+out))))
+ (close-port (car in+out))
+ (bytevector=? ref out)))))
+
(delete-file (test-file))
(delete-file (test-symlink))
diff --git a/test-suite/tests/gc.test b/test-suite/tests/gc.test
index a969752..04f3539 100644
--- a/test-suite/tests/gc.test
+++ b/test-suite/tests/gc.test
@@ -1,6 +1,6 @@
;;;; gc.test --- test guile's garbage collection -*- scheme -*-
;;;; Copyright (C) 2000, 2001, 2004, 2006, 2007, 2008, 2009,
-;;;; 2011, 2012 Free Software Foundation, Inc.
+;;;; 2011, 2012, 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
@@ -101,4 +101,4 @@
(guardian))
;; Prevent the optimizer from propagating f.
#:opts '(#:partial-eval? #f))))
- (equal? l '(foo)))))
+ (maybe-gc-flakiness (equal? l '(foo))))))
diff --git a/test-suite/tests/texinfo.serialize.test
b/test-suite/tests/texinfo.serialize.test
index 95e26b8..554390c 100644
--- a/test-suite/tests/texinfo.serialize.test
+++ b/test-suite/tests/texinfo.serialize.test
@@ -1,6 +1,6 @@
;;;; texinfo.serialize.test -*- scheme -*-
;;;;
-;;;; Copyright (C) 2010 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
@@ -103,7 +103,7 @@
"@iftex
This is only for tex.
-Note. Foo.
+Note. Foo.
@end iftex
diff --git a/test-suite/tests/texinfo.string-utils.test
b/test-suite/tests/texinfo.string-utils.test
index ad19df8..4f2e4c5 100644
--- a/test-suite/tests/texinfo.string-utils.test
+++ b/test-suite/tests/texinfo.string-utils.test
@@ -1,6 +1,6 @@
;;;; texinfo.string-utils.test -*- scheme -*-
;;;;
-;;;; Copyright (C) 2003, 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2009, 2010, 2013 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License as
@@ -109,6 +109,13 @@ to using the function `set-language-environment'.
variable should be set only with M-x customize, which is equivalent to using
the function `set-language-environment'.")))
+ (with-test-prefix "two spaces after end of sentence"
+ (pass-if-equal "This is a sentence. There should be two spaces before."
+ (fill-string "This is a sentence. There should be two spaces before."))
+
+ (pass-if-equal "This is version 2.0..."
+ (fill-string "This is version 2.0...")))
+
(with-test-prefix "test-no-word-break"
(pass-if (equal? "thisisalongword
blah
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-227-g86fafc4,
Ludovic Courtès <=