[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-14-134-g4
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-14-134-g4c35b9f |
|
Date: |
Sat, 29 Jan 2011 20:47:09 +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=4c35b9f31cb08da1fa9ad69a95de4f5e9f70813b
The branch, master has been updated
via 4c35b9f31cb08da1fa9ad69a95de4f5e9f70813b (commit)
via 9d46abb07bae2d9b5253d6895b68c775fc16a3de (commit)
via d21a1dc841da0c58ad027d6f0081a8093276b048 (commit)
via 0bc2452b5503211a114af64886fc3bdb08dad0b4 (commit)
from 043bca032670f55d79888ef7ead0b4a1a9480dce (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 4c35b9f31cb08da1fa9ad69a95de4f5e9f70813b
Author: Ludovic Courtès <address@hidden>
Date: Sat Jan 29 21:46:44 2011 +0100
Have `srfi-19.test' use the non-deprecated `format' style.
* test-suite/tests/srfi-19.test: Fix all uses of `format' to pass a port
or Boolean as the first argument.
commit 9d46abb07bae2d9b5253d6895b68c775fc16a3de
Author: Ludovic Courtès <address@hidden>
Date: Sat Jan 29 21:24:04 2011 +0100
Add a test for `send' and `recv!'.
* test-suite/tests/socket.test ("AF_UNIX/SOCK_STREAM")["bind (bis)",
"listen (bis)", "recv!", "accept (bis)"]: New tests.
commit d21a1dc841da0c58ad027d6f0081a8093276b048
Author: Ludovic Courtès <address@hidden>
Date: Sat Jan 29 21:34:44 2011 +0100
Have `recv!', `send', etc. accept a bytevector.
* libguile/socket.c (scm_recv, scm_send, scm_recvfrom, scm_sendto):
Expect the buffer to be a bytevector. Move the string-handling
code under `#if SCM_ENABLE_DEPRECATED == 1' and issue a deprecation
warning.
* test-suite/tests/socket.test ("AF_UNIX/SOCK_DGRAM")["sendto",
"sendto/sockaddr"]: Adjust accordingly.
* doc/ref/posix.texi (Network Sockets and Communication): Update
documentation of `recv!', `send', `recvfrom!', and `sendto'.
commit 0bc2452b5503211a114af64886fc3bdb08dad0b4
Author: Ludovic Courtès <address@hidden>
Date: Sat Jan 29 16:41:53 2011 +0100
Add `-lgc' to `Libs' in `guile-2.0.pc'.
This accounts for the fact that some public Guile macros and inline
functions use libgc functions.
* meta/guile-2.0.pc.in (Libs.private): Move @BDW_GC_LIBS@ to...
(Libs): ... here. Reported by Hans Aberg <address@hidden>.
* meta/guile-2.0-uninstalled.pc.in: Likewise.
-----------------------------------------------------------------------
Summary of changes:
doc/ref/posix.texi | 21 ++--
libguile/socket.c | 234 ++++++++++++++++++++++++++------------
meta/guile-2.0-uninstalled.pc.in | 4 +-
meta/guile-2.0.pc.in | 4 +-
test-suite/tests/socket.test | 94 ++++++++++++++--
test-suite/tests/srfi-19.test | 19 ++--
6 files changed, 273 insertions(+), 103 deletions(-)
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 156ed5c..4c43248 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -3188,7 +3188,7 @@ Note that on many systems the address of a socket in the
Receive data from a socket port.
@var{sock} must already
be bound to the address from which data is to be received.
address@hidden is a string into which
address@hidden is a bytevector into which
the data will be written. The size of @var{buf} limits
the amount of
data which can be received: in the case of packet
@@ -3215,7 +3215,7 @@ any unread buffered port data is ignored.
@vindex MSG_OOB
@vindex MSG_PEEK
@vindex MSG_DONTROUTE
-Transmit the string @var{message} on a socket port @var{sock}.
+Transmit bytevector @var{message} on socket port @var{sock}.
@var{sock} must already be bound to a destination address. The value
returned is the number of bytes transmitted---it's possible for this
to be less than the length of @var{message} if the socket is set to be
@@ -3227,17 +3227,18 @@ file descriptor:
any unflushed buffered port data is ignored.
@end deffn
address@hidden {Scheme Procedure} recvfrom! sock str [flags [start [end]]]
address@hidden {C Function} scm_recvfrom (sock, str, flags, start, end)
address@hidden {Scheme Procedure} recvfrom! sock buf [flags [start [end]]]
address@hidden {C Function} scm_recvfrom (sock, buf, flags, start, end)
Receive data from socket port @var{sock}, returning the originating
address as well as the data. This function is usually for datagram
sockets, but can be used on stream-oriented sockets too.
-The data received is stored in the given @var{str}, the whole string
-or just the region between the optional @var{start} and @var{end}
-positions. The size of @var{str} limits the amount of data which can
-be received. For datagram protocols if a packet larger than this is
-received then excess bytes are irrevocably lost.
+The data received is stored in bytevector @var{buf}, using
+either the whole bytevector or just the region between the optional
address@hidden and @var{end} positions. The size of @var{buf}
+limits the amount of data that can be received. For datagram
+protocols if a packet larger than this is received then excess
+bytes are irrevocably lost.
The return value is a pair. The @code{car} is the number of bytes
read. The @code{cdr} is a socket address object (@pxref{Network
@@ -3267,7 +3268,7 @@ application may need to use @code{select},
@code{O_NONBLOCK} or
@deffnx {Scheme Procedure} sendto sock message AF_INET6 ipv6addr port
[flowinfo [scopeid [flags]]]
@deffnx {Scheme Procedure} sendto sock message AF_UNIX path [flags]
@deffnx {C Function} scm_sendto (sock, message, fam, address, args_and_flags)
-Transmit the string @var{message} as a datagram on socket port
+Transmit bytevector @var{message} as a datagram socket port
@var{sock}. The destination is specified either as a socket address
object, or as arguments the same as would be taken by
@code{make-socket-address} to create such an object (@pxref{Network
diff --git a/libguile/socket.c b/libguile/socket.c
index 9b1618f..923bd9f 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -1,5 +1,6 @@
-/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007,
2009 Free Software Foundation, Inc.
- *
+/* Copyright (C) 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
+ * 2006, 2007, 2009, 2011 Free Software Foundation, Inc.
+ *
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
@@ -38,6 +39,10 @@
#include "libguile/validate.h"
#include "libguile/socket.h"
+#if SCM_ENABLE_DEPRECATED == 1
+# include "libguile/deprecation.h"
+#endif
+
#ifdef __MINGW32__
#include "win32-socket.h"
#endif
@@ -1352,15 +1357,13 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
"Receive data from a socket port.\n"
"@var{sock} must already\n"
"be bound to the address from which data is to be received.\n"
- "@var{buf} is a string into which\n"
+ "@var{buf} is a bytevector into which\n"
"the data will be written. The size of @var{buf} limits\n"
"the amount of\n"
"data which can be received: in the case of packet\n"
"protocols, if a packet larger than this limit is encountered\n"
"then some data\n"
"will be irrevocably lost.\n\n"
- "The data is assumed to be binary, and there is no decoding of\n"
- "of locale-encoded strings.\n\n"
"The optional @var{flags} argument is a value or\n"
"bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
"The value returned is the number of bytes read from the\n"
@@ -1370,38 +1373,55 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
"any unread buffered port data is ignored.")
#define FUNC_NAME s_scm_recv
{
- int rv;
- int fd;
- int flg;
- char *dest;
- size_t len;
- SCM msg;
+ int rv, fd, flg;
SCM_VALIDATE_OPFPORT (1, sock);
- SCM_VALIDATE_STRING (2, buf);
+
if (SCM_UNBNDP (flags))
flg = 0;
else
flg = scm_to_int (flags);
fd = SCM_FPORT_FDES (sock);
- len = scm_i_string_length (buf);
- msg = scm_i_make_string (len, &dest);
- SCM_SYSCALL (rv = recv (fd, dest, len, flg));
- scm_string_copy_x (buf, scm_from_int (0),
- msg, scm_from_int (0), scm_from_size_t (len));
+#if SCM_ENABLE_DEPRECATED == 1
+ if (SCM_UNLIKELY (scm_is_string (buf)))
+ {
+ SCM msg;
+ char *dest;
+ size_t len;
+
+ scm_c_issue_deprecation_warning
+ ("Passing a string to `recv!' is deprecated, "
+ "use a bytevector instead.");
+
+ len = scm_i_string_length (buf);
+ msg = scm_i_make_string (len, &dest);
+ SCM_SYSCALL (rv = recv (fd, dest, len, flg));
+ scm_string_copy_x (buf, scm_from_int (0),
+ msg, scm_from_int (0), scm_from_size_t (len));
+ }
+ else
+#endif
+ {
+ SCM_VALIDATE_BYTEVECTOR (1, buf);
+
+ SCM_SYSCALL (rv = recv (fd,
+ SCM_BYTEVECTOR_CONTENTS (buf),
+ SCM_BYTEVECTOR_LENGTH (buf),
+ flg));
+ }
- if (rv == -1)
+ if (SCM_UNLIKELY (rv == -1))
SCM_SYSERROR;
- scm_remember_upto_here_2 (buf, msg);
+ scm_remember_upto_here (buf);
return scm_from_int (rv);
}
#undef FUNC_NAME
SCM_DEFINE (scm_send, "send", 2, 1, 0,
(SCM sock, SCM message, SCM flags),
- "Transmit the string @var{message} on a socket port @var{sock}.\n"
+ "Transmit bytevector @var{message} on socket port @var{sock}.\n"
"@var{sock} must already be bound to a destination address. The\n"
"value returned is the number of bytes transmitted --\n"
"it's possible for\n"
@@ -1417,34 +1437,47 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
"zero to 255.")
#define FUNC_NAME s_scm_send
{
- int rv;
- int fd;
- int flg;
- char *src;
- size_t len;
+ int rv, fd, flg;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1, sock);
- SCM_VALIDATE_STRING (2, message);
-
- /* If the string is wide, see if it can be coerced into
- a narrow string. */
- if (!scm_i_is_narrow_string (message)
- || scm_i_try_narrow_string (message))
- SCM_MISC_ERROR ("the message string is not 8-bit: ~s",
- scm_list_1 (message));
if (SCM_UNBNDP (flags))
flg = 0;
else
flg = scm_to_int (flags);
+
fd = SCM_FPORT_FDES (sock);
- len = scm_i_string_length (message);
- message = scm_i_string_start_writing (message);
- src = scm_i_string_writable_chars (message);
- SCM_SYSCALL (rv = send (fd, src, len, flg));
- scm_i_string_stop_writing ();
+#if SCM_ENABLE_DEPRECATED == 1
+ if (SCM_UNLIKELY (scm_is_string (message)))
+ {
+ scm_c_issue_deprecation_warning
+ ("Passing a string to `send' is deprecated, "
+ "use a bytevector instead.");
+
+ /* If the string is wide, see if it can be coerced into a narrow
+ string. */
+ if (!scm_i_is_narrow_string (message)
+ || !scm_i_try_narrow_string (message))
+ SCM_MISC_ERROR ("the message string is not 8-bit: ~s",
+ scm_list_1 (message));
+
+ SCM_SYSCALL (rv = send (fd,
+ scm_i_string_chars (message),
+ scm_i_string_length (message),
+ flg));
+ }
+ else
+#endif
+ {
+ SCM_VALIDATE_BYTEVECTOR (1, message);
+
+ SCM_SYSCALL (rv = send (fd,
+ SCM_BYTEVECTOR_CONTENTS (message),
+ SCM_BYTEVECTOR_LENGTH (message),
+ flg));
+ }
if (rv == -1)
SCM_SYSERROR;
@@ -1455,22 +1488,22 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
#undef FUNC_NAME
SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
- (SCM sock, SCM str, SCM flags, SCM start, SCM end),
+ (SCM sock, SCM buf, SCM flags, SCM start, SCM end),
"Receive data from socket port @var{sock} (which must be already\n"
"bound), returning the originating address as well as the data.\n"
"This is usually for use on datagram sockets, but can be used on\n"
"stream-oriented sockets too.\n"
"\n"
- "The data received is stored in the given @var{str}, using\n"
- "either the whole string or just the region between the optional\n"
- "@var{start} and @var{end} positions. The size of @var{str}\n"
- "limits the amount of data which can be received. For datagram\n"
+ "The data received is stored in bytevector @var{buf}, using\n"
+ "either the whole bytevector or just the region between the
optional\n"
+ "@var{start} and @var{end} positions. The size of @var{buf}\n"
+ "limits the amount of data that can be received. For datagram\n"
"protocols, if a packet larger than this is received then excess\n"
"bytes are irrevocably lost.\n"
"\n"
"The return value is a pair. The @code{car} is the number of\n"
"bytes read. The @code{cdr} is a socket address object which is\n"
- "where the data come from, or @code{#f} if the origin is\n"
+ "where the data came from, or @code{#f} if the origin is\n"
"unknown.\n"
"\n"
"The optional @var{flags} argument is a or bitwise OR\n"
@@ -1486,46 +1519,79 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
"or @code{MSG_DONTWAIT} to avoid this.")
#define FUNC_NAME s_scm_recvfrom
{
- int rv;
- int fd;
- int flg;
- char *buf;
- size_t offset;
- size_t cend;
+ int rv, fd, flg;
SCM address;
+ size_t offset, cend;
socklen_t addr_size = MAX_ADDR_SIZE;
scm_t_max_sockaddr addr;
SCM_VALIDATE_OPFPORT (1, sock);
fd = SCM_FPORT_FDES (sock);
-
- SCM_VALIDATE_STRING (2, str);
- scm_i_get_substring_spec (scm_i_string_length (str),
- start, &offset, end, &cend);
if (SCM_UNBNDP (flags))
flg = 0;
else
SCM_VALIDATE_ULONG_COPY (3, flags, flg);
- /* recvfrom will not necessarily return an address. usually nothing
- is returned for stream sockets. */
- str = scm_i_string_start_writing (str);
- buf = scm_i_string_writable_chars (str);
((struct sockaddr *) &addr)->sa_family = AF_UNSPEC;
- SCM_SYSCALL (rv = recvfrom (fd, buf + offset,
- cend - offset, flg,
- (struct sockaddr *) &addr, &addr_size));
- scm_i_string_stop_writing ();
+
+#if SCM_ENABLE_DEPRECATED == 1
+ if (SCM_UNLIKELY (scm_is_string (buf)))
+ {
+ char *cbuf;
+
+ scm_c_issue_deprecation_warning
+ ("Passing a string to `recvfrom!' is deprecated, "
+ "use a bytevector instead.");
+
+ scm_i_get_substring_spec (scm_i_string_length (buf),
+ start, &offset, end, &cend);
+
+ buf = scm_i_string_start_writing (buf);
+ cbuf = scm_i_string_writable_chars (buf);
+
+ SCM_SYSCALL (rv = recvfrom (fd, cbuf + offset,
+ cend - offset, flg,
+ (struct sockaddr *) &addr, &addr_size));
+ scm_i_string_stop_writing ();
+ }
+ else
+#endif
+ {
+ SCM_VALIDATE_BYTEVECTOR (1, buf);
+
+ if (SCM_UNBNDP (start))
+ offset = 0;
+ else
+ offset = scm_to_size_t (start);
+
+ if (SCM_UNBNDP (end))
+ cend = SCM_BYTEVECTOR_LENGTH (buf);
+ else
+ {
+ cend = scm_to_size_t (end);
+ if (SCM_UNLIKELY (cend >= SCM_BYTEVECTOR_LENGTH (buf)
+ || cend < offset))
+ scm_out_of_range (FUNC_NAME, end);
+ }
+
+ SCM_SYSCALL (rv = recvfrom (fd,
+ SCM_BYTEVECTOR_CONTENTS (buf) + offset,
+ cend - offset, flg,
+ (struct sockaddr *) &addr, &addr_size));
+ }
if (rv == -1)
SCM_SYSERROR;
+
+ /* `recvfrom' does not necessarily return an address. Usually nothing
+ is returned for stream sockets. */
if (((struct sockaddr *) &addr)->sa_family != AF_UNSPEC)
address = _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
else
address = SCM_BOOL_F;
- scm_remember_upto_here_1 (str);
+ scm_remember_upto_here_1 (buf);
return scm_cons (scm_from_int (rv), address);
}
@@ -1533,7 +1599,7 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
SCM_DEFINE (scm_sendto, "sendto", 3, 1, 1,
(SCM sock, SCM message, SCM fam_or_sockaddr, SCM address, SCM
args_and_flags),
- "Transmit the string @var{message} on the socket port\n"
+ "Transmit bytevector @var{message} on socket port\n"
"@var{sock}. The\n"
"destination address is specified using the @var{fam},\n"
"@var{address} and\n"
@@ -1555,15 +1621,12 @@ SCM_DEFINE (scm_sendto, "sendto", 3, 1, 1,
"zero to 255.")
#define FUNC_NAME s_scm_sendto
{
- int rv;
- int fd;
- int flg;
+ int rv, fd, flg;
struct sockaddr *soka;
size_t size;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_FPORT (1, sock);
- SCM_VALIDATE_STRING (2, message);
fd = SCM_FPORT_FDES (sock);
if (!scm_is_number (fam_or_sockaddr))
@@ -1586,10 +1649,37 @@ SCM_DEFINE (scm_sendto, "sendto", 3, 1, 1,
SCM_VALIDATE_CONS (5, args_and_flags);
flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags));
}
- SCM_SYSCALL (rv = sendto (fd,
- scm_i_string_chars (message),
- scm_i_string_length (message),
- flg, soka, size));
+
+#if SCM_ENABLE_DEPRECATED == 1
+ if (SCM_UNLIKELY (scm_is_string (message)))
+ {
+ scm_c_issue_deprecation_warning
+ ("Passing a string to `sendto' is deprecated, "
+ "use a bytevector instead.");
+
+ /* If the string is wide, see if it can be coerced into a narrow
+ string. */
+ if (!scm_i_is_narrow_string (message)
+ || !scm_i_try_narrow_string (message))
+ SCM_MISC_ERROR ("the message string is not 8-bit: ~s",
+ scm_list_1 (message));
+
+ SCM_SYSCALL (rv = sendto (fd,
+ scm_i_string_chars (message),
+ scm_i_string_length (message),
+ flg, soka, size));
+ }
+ else
+#endif
+ {
+ SCM_VALIDATE_BYTEVECTOR (1, message);
+
+ SCM_SYSCALL (rv = sendto (fd,
+ SCM_BYTEVECTOR_CONTENTS (message),
+ SCM_BYTEVECTOR_LENGTH (message),
+ flg, soka, size));
+ }
+
if (rv == -1)
{
int save_errno = errno;
diff --git a/meta/guile-2.0-uninstalled.pc.in b/meta/guile-2.0-uninstalled.pc.in
index b5fdcad..9cc1aaf 100644
--- a/meta/guile-2.0-uninstalled.pc.in
+++ b/meta/guile-2.0-uninstalled.pc.in
@@ -4,6 +4,6 @@ address@hidden@
Name: GNU Guile (uninstalled)
Description: GNU's Ubiquitous Intelligent Language for Extension (uninstalled)
Version: @GUILE_VERSION@
-Libs: -L${builddir}/libguile address@hidden@
-Libs.private: @LIBGMP@ @LIBLTDL@ @BDW_GC_LIBS@ @LIBFFI_LIBS@ @GUILE_LIBS@
+Libs: -L${builddir}/libguile address@hidden@ @BDW_GC_LIBS@
+Libs.private: @LIBGMP@ @LIBLTDL@ @LIBFFI_LIBS@ @GUILE_LIBS@
Cflags: -I${srcdir} -I${builddir} @GUILE_CFLAGS@ @BDW_GC_CFLAGS@
diff --git a/meta/guile-2.0.pc.in b/meta/guile-2.0.pc.in
index 3366345..f76dd01 100644
--- a/meta/guile-2.0.pc.in
+++ b/meta/guile-2.0.pc.in
@@ -14,6 +14,6 @@ address@hidden@
Name: GNU Guile
Description: GNU's Ubiquitous Intelligent Language for Extension
Version: @GUILE_VERSION@
-Libs: -L${libdir} address@hidden@
-Libs.private: @LIBGMP@ @LIBLTDL@ @BDW_GC_LIBS@ @LIBFFI_LIBS@ @GUILE_LIBS@
+Libs: -L${libdir} address@hidden@ @BDW_GC_LIBS@
+Libs.private: @LIBGMP@ @LIBLTDL@ @LIBFFI_LIBS@ @GUILE_LIBS@
Cflags: -I${pkgincludedir}/@GUILE_EFFECTIVE_VERSION@ @GUILE_CFLAGS@
@BDW_GC_CFLAGS@
diff --git a/test-suite/tests/socket.test b/test-suite/tests/socket.test
index 7389cee..6deb285 100644
--- a/test-suite/tests/socket.test
+++ b/test-suite/tests/socket.test
@@ -1,22 +1,25 @@
;;;; socket.test --- test socket functions -*- scheme -*-
;;;;
-;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software
Foundation, Inc.
+;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+;;;; 2011 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
-;;;;
+;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
(define-module (test-suite test-socket)
+ #:use-module (rnrs bytevectors)
+ #:use-module (srfi srfi-26)
#:use-module (test-suite lib))
@@ -235,15 +238,17 @@
(pass-if "sendto"
(if (not server-bound?)
(throw 'unresolved)
- (let ((client (socket AF_UNIX SOCK_DGRAM 0)))
- (> (sendto client "hello" AF_UNIX path) 0))))
+ (let ((client (socket AF_UNIX SOCK_DGRAM 0))
+ (message (string->utf8 "hello")))
+ (> (sendto client message AF_UNIX path) 0))))
(pass-if "sendto/sockaddr"
(if (not server-bound?)
(throw 'unresolved)
- (let ((client (socket AF_UNIX SOCK_DGRAM 0))
+ (let ((client (socket AF_UNIX SOCK_DGRAM 0))
+ (message (string->utf8 "hello"))
(sockaddr (make-socket-address AF_UNIX path)))
- (> (sendto client "hello" sockaddr) 0))))
+ (> (sendto client message sockaddr) 0))))
(false-if-exception (delete-file path)))))
@@ -335,7 +340,80 @@
(false-if-exception (delete-file path))
- #t)))
+ #t)
+
+
+ ;; Testing `send', `recv!' & co. on stream-oriented sockets (with
+ ;; a bit of duplication with the above.)
+
+ (let ((server-socket (socket AF_UNIX SOCK_STREAM 0))
+ (server-bound? #f)
+ (server-listening? #f)
+ (server-pid #f)
+ (message "hello, world!")
+ (path (temp-file-path)))
+
+ (define (sub-bytevector bv len)
+ (let ((c (make-bytevector len)))
+ (bytevector-copy! bv 0 c 0 len)
+ c))
+
+ (pass-if "bind (bis)"
+ (catch 'system-error
+ (lambda ()
+ (bind server-socket AF_UNIX path)
+ (set! server-bound? #t)
+ #t)
+ (lambda args
+ (let ((errno (system-error-errno args)))
+ (cond ((= errno EADDRINUSE) (throw 'unresolved))
+ (else (apply throw args)))))))
+
+ (pass-if "listen (bis)"
+ (if (not server-bound?)
+ (throw 'unresolved)
+ (begin
+ (listen server-socket 123)
+ (set! server-listening? #t)
+ #t)))
+
+ (force-output (current-output-port))
+ (force-output (current-error-port))
+ (if server-listening?
+ (let ((pid (primitive-fork)))
+ ;; Spawn a server process.
+ (case pid
+ ((-1) (throw 'unresolved))
+ ((0) ;; the kid: send MESSAGE and exit
+ (exit
+ (false-if-exception
+ (let ((conn (car (accept server-socket)))
+ (bv (string->utf8 message)))
+ (= (bytevector-length bv)
+ (send conn bv))))))
+ (else ;; the parent
+ (set! server-pid pid)
+ #t))))
+
+ (pass-if "recv!"
+ (if (not server-pid)
+ (throw 'unresolved)
+ (let ((s (socket AF_UNIX SOCK_STREAM 0)))
+ (connect s AF_UNIX path)
+ (let* ((buf (make-bytevector 123))
+ (received (recv! s buf)))
+ (string=? (utf8->string (sub-bytevector buf received))
+ message)))))
+
+ (pass-if "accept (bis)"
+ (if (not server-pid)
+ (throw 'unresolved)
+ (let ((status (cdr (waitpid server-pid))))
+ (eq? 0 (status:exit-val status)))))
+
+ (false-if-exception (delete-file path))
+
+ #t)))
(if (defined? 'AF_INET6)
diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test
index f48ce62..8819c4f 100644
--- a/test-suite/tests/srfi-19.test
+++ b/test-suite/tests/srfi-19.test
@@ -1,18 +1,19 @@
;;;; srfi-19.test --- test suite for SRFI-19 -*- scheme -*-
;;;; Matthias Koeppe <address@hidden> --- June 2001
;;;;
-;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2007, 2008 Free Software
Foundation, Inc.
+;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2007, 2008,
+;;;; 2011 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
-;;;;
+;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
@@ -36,11 +37,11 @@ value and call THUNK."
(dynamic-wind
(lambda ()
(set! old-tz (getenv "TZ"))
- (putenv (format "TZ=~A" tz)))
+ (putenv (format #f "TZ=~A" tz)))
thunk
(lambda ()
(if old-tz
- (putenv (format "TZ=~A" old-tz))
+ (putenv (format #f "TZ=~A" old-tz))
(putenv "TZ"))))))
(defmacro with-tz (tz . body)
@@ -52,20 +53,20 @@ structure with integral seconds. (The seconds shall be
maintained as
integers, or precision may go away silently. The SRFI-19 reference
implementation was not OK for Guile in this respect because of Guile's
incomplete numerical tower implementation.)"
- (pass-if (format "~A makes integer seconds"
+ (pass-if (format #f "~A makes integer seconds"
date->time)
(exact? (time-second
(date->time (make-date 0 0 0 12 1 6 2001 0))))))
(define (test-time->date time->date date->time)
- (pass-if (format "~A works"
+ (pass-if (format #f "~A works"
time->date)
(begin
(time->date (date->time (make-date 0 0 0 12 1 6 2001 0)))
#t)))
(define (test-dst time->date date->time)
- (pass-if (format "~A respects local DST if no TZ-OFFSET given"
+ (pass-if (format #f "~A respects local DST if no TZ-OFFSET given"
time->date)
(let ((time (date->time (make-date 0 0 0 12 1 6 2001 0))))
;; on 2001-06-01, there should be 4 hours zone offset
@@ -78,7 +79,7 @@ incomplete numerical tower implementation.)"
(define-macro (test-time-conversion a b)
(let* ((a->b-sym (symbol-append a '-> b))
(b->a-sym (symbol-append b '-> a)))
- `(pass-if (format "~A and ~A work and are inverses of each other"
+ `(pass-if (format #f "~A and ~A work and are inverses of each other"
',a->b-sym ',b->a-sym)
(let ((time (make-time ,a 12345 67890123)))
(time=? time (,b->a-sym (,a->b-sym time)))))))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-14-134-g4c35b9f,
Ludovic Courtès <=