mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Merge commit 'fdd319e9bd
'
This commit is contained in:
commit
086bbcc874
7 changed files with 41 additions and 24 deletions
1
THANKS
1
THANKS
|
@ -134,6 +134,7 @@ For fixes or providing information which led to a fix:
|
||||||
Dan McMahill
|
Dan McMahill
|
||||||
Roger Mc Murtrie
|
Roger Mc Murtrie
|
||||||
Scott McPeak
|
Scott McPeak
|
||||||
|
Glenn Michaels
|
||||||
Andrew Milkowski
|
Andrew Milkowski
|
||||||
Tim Mooney
|
Tim Mooney
|
||||||
Han-Wen Nienhuys
|
Han-Wen Nienhuys
|
||||||
|
|
|
@ -623,7 +623,7 @@ SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0, 0,
|
||||||
c_len = SCM_BYTEVECTOR_LENGTH (bv);
|
c_len = SCM_BYTEVECTOR_LENGTH (bv);
|
||||||
c_bv = SCM_BYTEVECTOR_CONTENTS (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);
|
c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
|
||||||
memcpy (c_copy, c_bv, c_len);
|
memcpy (c_copy, c_bv, c_len);
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2004, 2006, 2010,
|
/* Copyright (C) 1995-1998, 2000, 2001, 2004, 2006, 2010, 2012-2014
|
||||||
* 2012, 2013, 2014 Free Software Foundation, Inc.
|
* Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* 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
|
#define FUNC_NAME s_scm_strerror
|
||||||
{
|
{
|
||||||
SCM ret;
|
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_dynwind_begin (0);
|
||||||
scm_i_dynwind_pthread_mutex_lock (&scm_i_misc_mutex);
|
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 ();
|
scm_dynwind_end ();
|
||||||
return ret;
|
return ret;
|
||||||
|
|
|
@ -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
|
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))
|
for (; !scm_is_null (extensions); extensions = SCM_CDR (extensions))
|
||||||
{
|
{
|
||||||
char *ext;
|
SCM extension;
|
||||||
size_t extlen;
|
|
||||||
int match;
|
extension = SCM_CAR (extensions);
|
||||||
ext = scm_to_locale_string (SCM_CAR (extensions));
|
if (scm_is_true (scm_string_suffix_p (extension, str,
|
||||||
extlen = strlen (ext);
|
SCM_UNDEFINED, SCM_UNDEFINED,
|
||||||
match = (len > extlen && str[len - extlen - 1] == '.'
|
SCM_UNDEFINED, SCM_UNDEFINED)))
|
||||||
&& strncmp (str + (len - extlen), ext, extlen) == 0);
|
|
||||||
free (ext);
|
|
||||||
if (match)
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -576,8 +575,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts,
|
||||||
if (is_absolute_file_name (filename))
|
if (is_absolute_file_name (filename))
|
||||||
{
|
{
|
||||||
if ((scm_is_false (require_exts) ||
|
if ((scm_is_false (require_exts) ||
|
||||||
scm_c_string_has_an_ext (filename_chars, filename_len,
|
string_has_an_ext (filename, extensions))
|
||||||
extensions))
|
|
||||||
&& stat (filename_chars, stat_buf) == 0
|
&& stat (filename_chars, stat_buf) == 0
|
||||||
&& !(stat_buf->st_mode & S_IFDIR))
|
&& !(stat_buf->st_mode & S_IFDIR))
|
||||||
result = filename;
|
result = filename;
|
||||||
|
@ -595,8 +593,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts,
|
||||||
if (*endp == '.')
|
if (*endp == '.')
|
||||||
{
|
{
|
||||||
if (scm_is_true (require_exts) &&
|
if (scm_is_true (require_exts) &&
|
||||||
!scm_c_string_has_an_ext (filename_chars, filename_len,
|
!string_has_an_ext (filename, extensions))
|
||||||
extensions))
|
|
||||||
{
|
{
|
||||||
/* This filename has an extension, but not one of the right
|
/* This filename has an extension, but not one of the right
|
||||||
ones... */
|
ones... */
|
||||||
|
|
|
@ -92,6 +92,8 @@
|
||||||
#define SCM_NUM2ULONG_LONG_DEF(pos, arg, def) \
|
#define SCM_NUM2ULONG_LONG_DEF(pos, arg, def) \
|
||||||
(SCM_UNBNDP (arg) ? def : scm_to_ulong_long (arg))
|
(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_NUM2FLOAT(pos, arg) ((float) scm_to_double (arg))
|
||||||
|
|
||||||
#define SCM_NUM2DOUBLE(pos, arg) (scm_to_double (arg))
|
#define SCM_NUM2DOUBLE(pos, arg) (scm_to_double (arg))
|
||||||
|
@ -201,6 +203,11 @@
|
||||||
cvar = SCM_NUM2LONG (pos, k); \
|
cvar = SCM_NUM2LONG (pos, k); \
|
||||||
} while (0)
|
} 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) \
|
#define SCM_VALIDATE_FLOAT_COPY(pos, k, cvar) \
|
||||||
do { \
|
do { \
|
||||||
cvar = SCM_NUM2FLOAT (pos, k); \
|
cvar = SCM_NUM2FLOAT (pos, k); \
|
||||||
|
|
|
@ -231,7 +231,7 @@ AC_DEFUN([GUILE_PROGS],
|
||||||
AC_MSG_ERROR([Guile $_guile_required_version required, but $_guile_prog_version found])
|
AC_MSG_ERROR([Guile $_guile_required_version required, but $_guile_prog_version found])
|
||||||
fi
|
fi
|
||||||
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.
|
# Allow prereleases that have the right effective version.
|
||||||
true
|
true
|
||||||
else
|
else
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*-
|
;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*-
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013,
|
;;;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
|
||||||
;;;; 2014 Free Software Foundation, Inc.
|
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Ludovic Courtès
|
;;;; Ludovic Courtès
|
||||||
;;;;
|
;;;;
|
||||||
|
@ -22,7 +21,8 @@
|
||||||
(define-module (test-bytevector)
|
(define-module (test-bytevector)
|
||||||
:use-module (test-suite lib)
|
:use-module (test-suite lib)
|
||||||
:use-module (system base compile)
|
: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
|
;;; Some of the tests in here are examples taken from the R6RS Standard
|
||||||
;;; Libraries document.
|
;;; Libraries document.
|
||||||
|
@ -692,6 +692,15 @@
|
||||||
(let ((bv (uniform-array->bytevector (make-bitvector 33 #t))))
|
(let ((bv (uniform-array->bytevector (make-bitvector 33 #t))))
|
||||||
(= (bytevector-length bv) 8))))
|
(= (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:
|
;;; Local Variables:
|
||||||
;;; eval: (put 'with-test-prefix/c&e 'scheme-indent-function 1)
|
;;; eval: (put 'with-test-prefix/c&e 'scheme-indent-function 1)
|
||||||
;;; End:
|
;;; End:
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue