summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2015-01-22 13:04:34 +0100
committerAndy Wingo <wingo@pobox.com>2015-01-22 13:04:34 +0100
commit086bbcc874f230c709b7c0a46439c2fd3f7cd37c (patch)
tree9a7d42c5a3c7880c50ff4d679ae2e8cf91149dfc
parentd5dffec4ffcb93ab649acb2b6f7d8a013ba0e10e (diff)
parentfdd319e9bd4121d844662d3d8ccc69b462b60840 (diff)
downloadguile-086bbcc874f230c709b7c0a46439c2fd3f7cd37c.tar.gz
Merge commit 'fdd319e9bd4121d844662d3d8ccc69b462b60840'
-rw-r--r--THANKS1
-rw-r--r--libguile/bytevectors.c2
-rw-r--r--libguile/error.c9
-rw-r--r--libguile/load.c29
-rw-r--r--libguile/validate.h7
-rw-r--r--meta/guile.m42
-rw-r--r--test-suite/tests/bytevectors.test15
7 files changed, 41 insertions, 24 deletions
diff --git a/THANKS b/THANKS
index 1aeb4a429..d5e8222fb 100644
--- a/THANKS
+++ b/THANKS
@@ -134,6 +134,7 @@ For fixes or providing information which led to a fix:
Dan McMahill
Roger Mc Murtrie
Scott McPeak
+ Glenn Michaels
Andrew Milkowski
Tim Mooney
Han-Wen Nienhuys
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index dda912ff0..b5e28e412 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -623,7 +623,7 @@ SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0, 0,
c_len = SCM_BYTEVECTOR_LENGTH (bv);
c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
- copy = make_bytevector (c_len, SCM_BYTEVECTOR_ELEMENT_TYPE (bv));
+ copy = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
memcpy (c_copy, c_bv, c_len);
diff --git a/libguile/error.c b/libguile/error.c
index 2878fa0dd..89345c2b7 100644
--- a/libguile/error.c
+++ b/libguile/error.c
@@ -1,5 +1,5 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2004, 2006, 2010,
- * 2012, 2013, 2014 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1998, 2000, 2001, 2004, 2006, 2010, 2012-2014
+ * Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -121,10 +121,13 @@ SCM_DEFINE (scm_strerror, "strerror", 1, 0, 0,
#define FUNC_NAME s_scm_strerror
{
SCM ret;
+ int errnum = scm_to_int (err); /* Must be done outside of the
+ critical section below, to avoid a
+ deadlock on errors. */
scm_dynwind_begin (0);
scm_i_dynwind_pthread_mutex_lock (&scm_i_misc_mutex);
- ret = scm_from_locale_string (strerror (scm_to_int (err)));
+ ret = scm_from_locale_string (strerror (errnum));
scm_dynwind_end ();
return ret;
diff --git a/libguile/load.c b/libguile/load.c
index b6e07a549..74f3bb49b 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -469,23 +469,22 @@ stringbuf_cat (struct stringbuf *buf, char *str)
}
}
-
+/* Return non-zero if STR is suffixed by a dot followed by one of
+ EXTENSIONS. */
static int
-scm_c_string_has_an_ext (char *str, size_t len, SCM extensions)
+string_has_an_ext (SCM str, SCM extensions)
{
for (; !scm_is_null (extensions); extensions = SCM_CDR (extensions))
{
- char *ext;
- size_t extlen;
- int match;
- ext = scm_to_locale_string (SCM_CAR (extensions));
- extlen = strlen (ext);
- match = (len > extlen && str[len - extlen - 1] == '.'
- && strncmp (str + (len - extlen), ext, extlen) == 0);
- free (ext);
- if (match)
- return 1;
+ SCM extension;
+
+ extension = SCM_CAR (extensions);
+ if (scm_is_true (scm_string_suffix_p (extension, str,
+ SCM_UNDEFINED, SCM_UNDEFINED,
+ SCM_UNDEFINED, SCM_UNDEFINED)))
+ return 1;
}
+
return 0;
}
@@ -576,8 +575,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts,
if (is_absolute_file_name (filename))
{
if ((scm_is_false (require_exts) ||
- scm_c_string_has_an_ext (filename_chars, filename_len,
- extensions))
+ string_has_an_ext (filename, extensions))
&& stat (filename_chars, stat_buf) == 0
&& !(stat_buf->st_mode & S_IFDIR))
result = filename;
@@ -595,8 +593,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts,
if (*endp == '.')
{
if (scm_is_true (require_exts) &&
- !scm_c_string_has_an_ext (filename_chars, filename_len,
- extensions))
+ !string_has_an_ext (filename, extensions))
{
/* This filename has an extension, but not one of the right
ones... */
diff --git a/libguile/validate.h b/libguile/validate.h
index 6d57b9e32..516a6f750 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -92,6 +92,8 @@
#define SCM_NUM2ULONG_LONG_DEF(pos, arg, def) \
(SCM_UNBNDP (arg) ? def : scm_to_ulong_long (arg))
+#define SCM_NUM2SIZE(pos, arg) (scm_to_size_t (arg))
+
#define SCM_NUM2FLOAT(pos, arg) ((float) scm_to_double (arg))
#define SCM_NUM2DOUBLE(pos, arg) (scm_to_double (arg))
@@ -201,6 +203,11 @@
cvar = SCM_NUM2LONG (pos, k); \
} while (0)
+#define SCM_VALIDATE_SIZE_COPY(pos, k, cvar) \
+ do { \
+ cvar = SCM_NUM2SIZE (pos, k); \
+ } while (0)
+
#define SCM_VALIDATE_FLOAT_COPY(pos, k, cvar) \
do { \
cvar = SCM_NUM2FLOAT (pos, k); \
diff --git a/meta/guile.m4 b/meta/guile.m4
index 441dcd4e8..dd3c212e8 100644
--- a/meta/guile.m4
+++ b/meta/guile.m4
@@ -231,7 +231,7 @@ AC_DEFUN([GUILE_PROGS],
AC_MSG_ERROR([Guile $_guile_required_version required, but $_guile_prog_version found])
fi
fi
- elif test "$GUILE_EFFECTIVE_VERSION" == "$_major_version.$_minor_version" -a -z "$_micro_version"; then
+ elif test "$GUILE_EFFECTIVE_VERSION" = "$_major_version.$_minor_version" -a -z "$_micro_version"; then
# Allow prereleases that have the right effective version.
true
else
diff --git a/test-suite/tests/bytevectors.test b/test-suite/tests/bytevectors.test
index c4ae1bbbb..91367db08 100644
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -1,7 +1,6 @@
;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013,
-;;;; 2014 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;;;;
;;;; Ludovic Courtès
;;;;
@@ -22,7 +21,8 @@
(define-module (test-bytevector)
:use-module (test-suite lib)
:use-module (system base compile)
- :use-module (rnrs bytevectors))
+ :use-module (rnrs bytevectors)
+ :use-module (srfi srfi-4))
;;; Some of the tests in here are examples taken from the R6RS Standard
;;; Libraries document.
@@ -692,6 +692,15 @@
(let ((bv (uniform-array->bytevector (make-bitvector 33 #t))))
(= (bytevector-length bv) 8))))
+
+(with-test-prefix "srfi-4 homogeneous numeric vectors as bytevectors"
+
+ ;; This failed prior to Guile 2.0.12.
+ ;; See <http://bugs.gnu.org/18866>.
+ (pass-if-equal "bytevector-copy on srfi-4 arrays"
+ (make-bytevector 8 #xFF)
+ (bytevector-copy (make-u32vector 2 #xFFFFFFFF))))
+
;;; Local Variables:
;;; eval: (put 'with-test-prefix/c&e 'scheme-indent-function 1)
;;; End: