mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 04:10:18 +02:00
Change uses of scm_is_simple_vector to scm_is_vector
* libguile/filesys.c, libguile/random.c, libguile/stime.c, libguile/trees.c, libguile/validate.h: use scm_is_vector instead of scm_is_simple_vector. * libguile/sort.c (scm_sort_x, scm_sort, scm_stable_sort_x) (scm_stable_sort): Remove scm_is_vector check; scm_is_array is sufficient. * test-suite/tests/arrays.test: Fix header. * test-suite/tests/random.test: New coverage test covering random:normal-vector!. * test-suite/Makefile.am: Include random.test in make check.
This commit is contained in:
Daniel Llorens
Andy Wingo
parent
a32488ba13
commit
d747313100
9 changed files with 76 additions and 27 deletions
|
|
@ -694,7 +694,7 @@ fill_select_type (fd_set *set, SCM *ports_ready, SCM list_or_vec, int pos)
|
|||
{
|
||||
int max_fd = 0;
|
||||
|
||||
if (scm_is_simple_vector (list_or_vec))
|
||||
if (scm_is_vector (list_or_vec))
|
||||
{
|
||||
int i = SCM_SIMPLE_VECTOR_LENGTH (list_or_vec);
|
||||
|
||||
|
|
@ -755,7 +755,7 @@ retrieve_select_type (fd_set *set, SCM ports_ready, SCM list_or_vec)
|
|||
{
|
||||
SCM answer_list = ports_ready;
|
||||
|
||||
if (scm_is_simple_vector (list_or_vec))
|
||||
if (scm_is_vector (list_or_vec))
|
||||
{
|
||||
int i = SCM_SIMPLE_VECTOR_LENGTH (list_or_vec);
|
||||
|
||||
|
|
@ -824,7 +824,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
|
|||
SCM write_ports_ready = SCM_EOL;
|
||||
int max_fd;
|
||||
|
||||
if (scm_is_simple_vector (reads))
|
||||
if (scm_is_vector (reads))
|
||||
{
|
||||
read_count = SCM_SIMPLE_VECTOR_LENGTH (reads);
|
||||
}
|
||||
|
|
@ -833,7 +833,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
|
|||
read_count = scm_ilength (reads);
|
||||
SCM_ASSERT (read_count >= 0, reads, SCM_ARG1, FUNC_NAME);
|
||||
}
|
||||
if (scm_is_simple_vector (writes))
|
||||
if (scm_is_vector (writes))
|
||||
{
|
||||
write_count = SCM_SIMPLE_VECTOR_LENGTH (writes);
|
||||
}
|
||||
|
|
@ -842,7 +842,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
|
|||
write_count = scm_ilength (writes);
|
||||
SCM_ASSERT (write_count >= 0, writes, SCM_ARG2, FUNC_NAME);
|
||||
}
|
||||
if (scm_is_simple_vector (excepts))
|
||||
if (scm_is_vector (excepts))
|
||||
{
|
||||
except_count = SCM_SIMPLE_VECTOR_LENGTH (excepts);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -504,7 +504,7 @@ static void
|
|||
vector_scale_x (SCM v, double c)
|
||||
{
|
||||
size_t n;
|
||||
if (scm_is_simple_vector (v))
|
||||
if (scm_is_vector (v))
|
||||
{
|
||||
n = SCM_SIMPLE_VECTOR_LENGTH (v);
|
||||
while (n-- > 0)
|
||||
|
|
@ -532,7 +532,7 @@ vector_sum_squares (SCM v)
|
|||
{
|
||||
double x, sum = 0.0;
|
||||
size_t n;
|
||||
if (scm_is_simple_vector (v))
|
||||
if (scm_is_vector (v))
|
||||
{
|
||||
n = SCM_SIMPLE_VECTOR_LENGTH (v);
|
||||
while (n-- > 0)
|
||||
|
|
@ -626,7 +626,7 @@ SCM_DEFINE (scm_random_normal_vector_x, "random:normal-vector!", 1, 1, 0,
|
|||
scm_generalized_vector_get_handle (v, &handle);
|
||||
dim = scm_array_handle_dims (&handle);
|
||||
|
||||
if (scm_is_vector (v))
|
||||
if (handle.element_type == SCM_ARRAY_ELEMENT_TYPE_SCM)
|
||||
{
|
||||
SCM *elts = scm_array_handle_writable_elements (&handle);
|
||||
for (i = dim->lbnd; i <= dim->ubnd; i++, elts += dim->inc)
|
||||
|
|
|
|||
|
|
@ -377,8 +377,7 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0,
|
|||
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
|
||||
return scm_merge_list_step (&items, less, len);
|
||||
}
|
||||
else if (scm_is_simple_vector (items)
|
||||
|| (scm_is_array (items) && scm_c_array_rank (items) == 1))
|
||||
else if (scm_is_array (items) && scm_c_array_rank (items) == 1)
|
||||
{
|
||||
scm_restricted_vector_sort_x (items,
|
||||
less,
|
||||
|
|
@ -404,8 +403,7 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0,
|
|||
|
||||
if (scm_is_pair (items))
|
||||
return scm_sort_x (scm_list_copy (items), less);
|
||||
else if (scm_is_simple_vector (items)
|
||||
|| (scm_is_array (items) && scm_c_array_rank (items) == 1))
|
||||
else if (scm_is_array (items) && scm_c_array_rank (items) == 1)
|
||||
return scm_sort_x (scm_vector_copy (items), less);
|
||||
else
|
||||
SCM_WRONG_TYPE_ARG (1, items);
|
||||
|
|
@ -491,8 +489,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
|
|||
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
|
||||
return scm_merge_list_step (&items, less, len);
|
||||
}
|
||||
else if (scm_is_simple_vector (items)
|
||||
|| (scm_is_array (items) && scm_c_array_rank (items) == 1))
|
||||
else if (scm_is_array (items) && 1 == scm_c_array_rank (items))
|
||||
{
|
||||
scm_t_array_handle temp_handle, vec_handle;
|
||||
SCM temp, *temp_elts, *vec_elts;
|
||||
|
|
@ -535,11 +532,8 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0,
|
|||
|
||||
if (scm_is_pair (items))
|
||||
return scm_stable_sort_x (scm_list_copy (items), less);
|
||||
else if (scm_is_simple_vector (items)
|
||||
|| (scm_is_array (items) && scm_c_array_rank (items) == 1))
|
||||
return scm_stable_sort_x (scm_vector_copy (items), less);
|
||||
else
|
||||
SCM_WRONG_TYPE_ARG (1, items);
|
||||
return scm_stable_sort_x (scm_vector_copy (items), less);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
|
|||
|
|
@ -506,7 +506,7 @@ SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0,
|
|||
static void
|
||||
bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
|
||||
{
|
||||
SCM_ASSERT (scm_is_simple_vector (sbd_time)
|
||||
SCM_ASSERT (scm_is_vector (sbd_time)
|
||||
&& SCM_SIMPLE_VECTOR_LENGTH (sbd_time) == 11,
|
||||
sbd_time, pos, subr);
|
||||
|
||||
|
|
|
|||
|
|
@ -99,7 +99,7 @@ copy_tree (struct t_trace *const hare,
|
|||
unsigned int tortoise_delay)
|
||||
#define FUNC_NAME s_scm_copy_tree
|
||||
{
|
||||
if (!scm_is_pair (hare->obj) && !scm_is_simple_vector (hare->obj))
|
||||
if (!scm_is_pair (hare->obj) && !scm_is_vector (hare->obj))
|
||||
{
|
||||
return hare->obj;
|
||||
}
|
||||
|
|
@ -128,7 +128,7 @@ copy_tree (struct t_trace *const hare,
|
|||
--tortoise_delay;
|
||||
}
|
||||
|
||||
if (scm_is_simple_vector (hare->obj))
|
||||
if (scm_is_vector (hare->obj))
|
||||
{
|
||||
size_t length = SCM_SIMPLE_VECTOR_LENGTH (hare->obj);
|
||||
SCM new_vector = scm_c_make_vector (length, SCM_UNSPECIFIED);
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
#define SCM_VALIDATE_H
|
||||
|
||||
/* Copyright (C) 1999, 2000, 2001, 2002, 2004, 2006, 2007, 2009,
|
||||
* 2011, 2012, 2013 Free Software Foundation, Inc.
|
||||
* 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 License
|
||||
|
|
@ -358,13 +358,12 @@
|
|||
|
||||
#define SCM_VALIDATE_VECTOR(pos, v) \
|
||||
do { \
|
||||
SCM_ASSERT (scm_is_simple_vector (v), v, pos, FUNC_NAME); \
|
||||
SCM_ASSERT (scm_is_vector (v), v, pos, FUNC_NAME); \
|
||||
} while (0)
|
||||
|
||||
#define SCM_VALIDATE_VECTOR_OR_DVECTOR(pos, v) \
|
||||
do { \
|
||||
SCM_ASSERT ((scm_is_simple_vector (v) \
|
||||
|| (scm_is_true (scm_f64vector_p (v)))), \
|
||||
SCM_ASSERT (scm_is_vector (v) || scm_is_true (scm_f64vector_p (v)), \
|
||||
v, pos, FUNC_NAME); \
|
||||
} while (0)
|
||||
|
||||
|
|
|
|||
|
|
@ -111,6 +111,7 @@ SCM_TESTS = tests/00-initial-env.test \
|
|||
tests/r6rs-unicode.test \
|
||||
tests/rnrs-libraries.test \
|
||||
tests/ramap.test \
|
||||
tests/random.test \
|
||||
tests/rdelim.test \
|
||||
tests/reader.test \
|
||||
tests/receive.test \
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;;; unif.test --- tests guile's uniform arrays -*- scheme -*-
|
||||
;;;; arrays.test --- tests guile's uniform arrays -*- scheme -*-
|
||||
;;;;
|
||||
;;;; Copyright 2004, 2006, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
|
|
|
|||
55
test-suite/tests/random.test
Normal file
55
test-suite/tests/random.test
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
;;;; random.test --- tests guile's uniform arrays -*- scheme -*-
|
||||
;;;;
|
||||
;;;; Copyright 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 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-random)
|
||||
#:use-module ((system base compile) #:select (compile))
|
||||
#:use-module (test-suite lib)
|
||||
#:use-module (srfi srfi-4)
|
||||
#:use-module (srfi srfi-4 gnu))
|
||||
|
||||
; see strings.test, arrays.test.
|
||||
(define exception:wrong-type-arg
|
||||
(cons #t "Wrong type"))
|
||||
|
||||
;;;
|
||||
;;; random:normal-vector!
|
||||
;;;
|
||||
|
||||
(with-test-prefix "random:normal-vector!"
|
||||
|
||||
;; FIXME need proper function test.
|
||||
|
||||
(pass-if "non uniform"
|
||||
(let ((a (make-vector 4 0))
|
||||
(b (make-vector 4 0))
|
||||
(c (make-shared-array (make-vector 8 0)
|
||||
(lambda (i) (list (+ 1 (* 2 i)))) 4)))
|
||||
(begin
|
||||
(random:normal-vector! b (random-state-from-platform))
|
||||
(random:normal-vector! c (random-state-from-platform))
|
||||
(and (not (equal? a b)) (not (equal? a c))))))
|
||||
|
||||
(pass-if "uniform (f64)"
|
||||
(let ((a (make-f64vector 4 0))
|
||||
(b (make-f64vector 4 0))
|
||||
(c (make-shared-array (make-f64vector 8 0)
|
||||
(lambda (i) (list (+ 1 (* 2 i)))) 4)))
|
||||
(begin
|
||||
(random:normal-vector! b (random-state-from-platform))
|
||||
(random:normal-vector! c (random-state-from-platform))
|
||||
(and (not (equal? a b)) (not (equal? a c)))))))
|
||||
Loading…
Add table
Add a link
Reference in a new issue