[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-635-g16259ae
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-635-g16259ae |
|
Date: |
Thu, 06 Feb 2014 15:47:08 +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=16259ae3dcf4f121ec1ba3aa49090dfa9fef995f
The branch, master has been updated
via 16259ae3dcf4f121ec1ba3aa49090dfa9fef995f (commit)
via 5e8c9d4ad5d225611f340cdcf285aee7c8a1908a (commit)
via c4aca3b9da9e7777f84efcd304990ad78b883f07 (commit)
via 1fadf369b8eb2eec2011707ef1831c01ae134a37 (commit)
via 9da9c22f846e2aa369593458201d5b5c7775b668 (commit)
via 4a7dac39a9021eeb26beefaf72d3ce63624940a0 (commit)
via 7e7e3b7f06e01022f29dc4549e955641f7052016 (commit)
from b914b236c3d6a6772597278e97b80bdb34129291 (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 16259ae3dcf4f121ec1ba3aa49090dfa9fef995f
Author: Daniel Llorens <address@hidden>
Date: Wed May 8 01:54:29 2013 +0200
Don't use generalized-vector in array-map.c (II)
* libguile/array-map.c
- replace scm_is_generalized_vector by scm_is_array && !SCM_I_ARRAY_P.
- replace scm_c_generalized_vector_length by scm_c_array_length.
- remove header.
commit 5e8c9d4ad5d225611f340cdcf285aee7c8a1908a
Author: Daniel Llorens <address@hidden>
Date: Mon Apr 8 13:34:41 2013 +0200
Don't use generalized-vector in array-map.c (I)
* array-map.c: (AREF, ASET): Rename from GVREF, GVSET and use rank-1
array accessors.
commit c4aca3b9da9e7777f84efcd304990ad78b883f07
Author: Daniel Llorens <address@hidden>
Date: Thu Feb 6 11:17:47 2014 +0100
Don't use generalized-vector functions in uniform.c
* libguile/uniform.c (scm_is_uniform_vector): Replace
scm_is_generalized_vector and scm_generalized_vector_get_handle by
scm_is_array and manual rank check.
(scm_c_uniform_vector_length): Use scm_c_array_length.
(scm_c_uniform_vector_ref): Use scm_c_array_ref_1.
(scm_c_uniform_vector_set): Use scm_c_array_set_1_x.
(scm_uniform_vector_writable_elements): Use scm_array_get_handle, and
assert that the rank is 1.
* test-suite/test/arrays.test: Rename the uniform-vector-ref block to
uniform-vector. Exercise uniform-vector-length and shared arrays
remaining uniform.
Modifications by Andy Wingo <address@hidden>.
commit 1fadf369b8eb2eec2011707ef1831c01ae134a37
Author: Andy Wingo <address@hidden>
Date: Thu Feb 6 11:02:20 2014 +0100
Replace generalized-vector calls in array_handle_ref/set
* libguile/arrays.c: (array-handle-ref, array-handle-set): Use the
rank-1 array accessors.
commit 9da9c22f846e2aa369593458201d5b5c7775b668
Author: Daniel Llorens <address@hidden>
Date: Tue Apr 9 18:17:21 2013 +0200
Replace scm_c_generalized_vector_length in arrays.c
* libguile/arrays.c: (scm_array_contents, scm_make_shared_array):
arrays are known of rank 1 so replace by scm_c_array_length.
commit 4a7dac39a9021eeb26beefaf72d3ce63624940a0
Author: Daniel Llorens <address@hidden>
Date: Tue Apr 9 18:09:49 2013 +0200
Replace scm_c_generalized_vector_length in random.c
* libguile/random.c: (random:solid-sphere!): array is of known
rank 1, so use scm_c_array_length() instead.
commit 7e7e3b7f06e01022f29dc4549e955641f7052016
Author: Daniel Llorens <address@hidden>
Date: Thu Apr 18 15:10:29 2013 +0200
Tests for array-copy!, empty case
* test-suite/tests/ramap.test: test array-copy! with empty destination.
Fix uses of constant array as destination.
-----------------------------------------------------------------------
Summary of changes:
libguile/array-map.c | 94 ++++++++++++++++++++++--------------------
libguile/arrays.c | 20 ++++----
libguile/random.c | 4 +-
libguile/uniform.c | 27 ++++++------
test-suite/tests/arrays.test | 24 +++++++++--
test-suite/tests/ramap.test | 56 +++++++++++++++----------
6 files changed, 129 insertions(+), 96 deletions(-)
diff --git a/libguile/array-map.c b/libguile/array-map.c
index e47fb56..961d474 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1996, 1998, 2000, 2001, 2004, 2005, 2006, 2008, 2009,
- * 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ * 2010, 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
@@ -39,7 +39,6 @@
#include "libguile/bitvectors.h"
#include "libguile/srfi-4.h"
#include "libguile/generalized-arrays.h"
-#include "libguile/generalized-vectors.h"
#include "libguile/validate.h"
#include "libguile/array-map.h"
@@ -48,9 +47,17 @@
/* The WHAT argument for `scm_gc_malloc ()' et al. */
static const char indices_gc_hint[] = "array-indices";
+static SCM
+AREF (SCM v, size_t pos)
+{
+ return scm_c_array_ref_1 (v, pos);
+}
-#define GVREF scm_c_generalized_vector_ref
-#define GVSET scm_c_generalized_vector_set_x
+static void
+ASET (SCM v, size_t pos, SCM val)
+{
+ scm_c_array_set_1_x (v, val, pos);
+}
static unsigned long
cind (SCM ra, long *ve)
@@ -85,34 +92,34 @@ scm_ra_matchp (SCM ra0, SCM ras)
int i, ndim = 1;
int exact = 2 /* 4 */ ; /* Don't care about values >2 (yet?) */
- if (scm_is_generalized_vector (ra0))
+ if (!scm_is_array (ra0))
+ return 0;
+ else if (!SCM_I_ARRAYP (ra0))
{
s0->lbnd = 0;
s0->inc = 1;
- s0->ubnd = scm_c_generalized_vector_length (ra0) - 1;
+ s0->ubnd = scm_c_array_length (ra0) - 1;
}
- else if (SCM_I_ARRAYP (ra0))
+ else
{
ndim = SCM_I_ARRAY_NDIM (ra0);
s0 = SCM_I_ARRAY_DIMS (ra0);
bas0 = SCM_I_ARRAY_BASE (ra0);
}
- else
- return 0;
while (scm_is_pair (ras))
{
ra1 = SCM_CAR (ras);
-
- if (scm_is_generalized_vector (ra1))
+
+ if (!SCM_I_ARRAYP (ra1))
{
size_t length;
-
+
if (1 != ndim)
return 0;
-
- length = scm_c_generalized_vector_length (ra1);
-
+
+ length = scm_c_array_length (ra1);
+
switch (exact)
{
case 4:
@@ -130,7 +137,7 @@ scm_ra_matchp (SCM ra0, SCM ras)
return 0;
}
}
- else if (SCM_I_ARRAYP (ra1) && ndim == SCM_I_ARRAY_NDIM (ra1))
+ else if (ndim == SCM_I_ARRAY_NDIM (ra1))
{
s1 = SCM_I_ARRAY_DIMS (ra1);
if (bas0 != SCM_I_ARRAY_BASE (ra1))
@@ -194,7 +201,7 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra,
const char *what)
if (SCM_IMP (vra0)) goto gencase;
if (!SCM_I_ARRAYP (vra0))
{
- size_t length = scm_c_generalized_vector_length (vra0);
+ size_t length = scm_c_array_length (vra0);
vra1 = scm_i_make_array (1);
SCM_I_ARRAY_BASE (vra1) = 0;
SCM_I_ARRAY_DIMS (vra1)->lbnd = 0;
@@ -252,7 +259,7 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra,
const char *what)
}
else
{
- size_t length = scm_c_generalized_vector_length (ra0);
+ size_t length = scm_c_array_length (ra0);
kmax = 0;
SCM_I_ARRAY_DIMS (vra0)->lbnd = 0;
SCM_I_ARRAY_DIMS (vra0)->ubnd = length - 1;
@@ -407,7 +414,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
ra = SCM_I_ARRAY_V (ra);
for (i = base; n--; i += inc)
- GVSET (ra, i, fill);
+ ASET (ra, i, fill);
return 1;
}
@@ -437,7 +444,7 @@ scm_ra_eqp (SCM ra0, SCM ras)
{
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
if (scm_is_true (scm_array_handle_ref (&ra0_handle, i0)))
- if (!scm_is_eq (GVREF (ra1, i1), GVREF (ra2, i2)))
+ if (!scm_is_eq (AREF (ra1, i1), AREF (ra2, i2)))
scm_array_handle_set (&ra0_handle, i0, SCM_BOOL_F);
}
@@ -470,8 +477,8 @@ ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt)
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
if (scm_is_true (scm_array_handle_ref (&ra0_handle, i0)))
if (opt ?
- scm_is_true (scm_less_p (GVREF (ra1, i1), GVREF (ra2, i2))) :
- scm_is_false (scm_less_p (GVREF (ra1, i1), GVREF (ra2, i2))))
+ scm_is_true (scm_less_p (AREF (ra1, i1), AREF (ra2, i2))) :
+ scm_is_false (scm_less_p (AREF (ra1, i1), AREF (ra2, i2))))
scm_array_handle_set (&ra0_handle, i0, SCM_BOOL_F);
}
@@ -527,7 +534,7 @@ scm_ra_sum (SCM ra0, SCM ras)
default:
{
for (; n-- > 0; i0 += inc0, i1 += inc1)
- GVSET (ra0, i0, scm_sum (GVREF(ra0, i0), GVREF(ra1, i1)));
+ ASET (ra0, i0, scm_sum (AREF(ra0, i0), AREF(ra1, i1)));
break;
}
}
@@ -551,7 +558,7 @@ scm_ra_difference (SCM ra0, SCM ras)
default:
{
for (; n-- > 0; i0 += inc0)
- GVSET (ra0, i0, scm_difference (GVREF(ra0, i0), SCM_UNDEFINED));
+ ASET (ra0, i0, scm_difference (AREF(ra0, i0), SCM_UNDEFINED));
break;
}
}
@@ -567,8 +574,7 @@ scm_ra_difference (SCM ra0, SCM ras)
default:
{
for (; n-- > 0; i0 += inc0, i1 += inc1)
- GVSET (ra0, i0, scm_difference (GVREF (ra0, i0),
- GVREF (ra1, i1)));
+ ASET (ra0, i0, scm_difference (AREF (ra0, i0), AREF (ra1, i1)));
break;
}
}
@@ -596,8 +602,7 @@ scm_ra_product (SCM ra0, SCM ras)
default:
{
for (; n-- > 0; i0 += inc0, i1 += inc1)
- GVSET (ra0, i0, scm_product (GVREF (ra0, i0),
- GVREF (ra1, i1)));
+ ASET (ra0, i0, scm_product (AREF (ra0, i0), AREF (ra1, i1)));
}
}
}
@@ -619,7 +624,7 @@ scm_ra_divide (SCM ra0, SCM ras)
default:
{
for (; n-- > 0; i0 += inc0)
- GVSET (ra0, i0, scm_divide (GVREF (ra0, i0), SCM_UNDEFINED));
+ ASET (ra0, i0, scm_divide (AREF (ra0, i0), SCM_UNDEFINED));
break;
}
}
@@ -636,9 +641,8 @@ scm_ra_divide (SCM ra0, SCM ras)
{
for (; n-- > 0; i0 += inc0, i1 += inc1)
{
- SCM res = scm_divide (GVREF (ra0, i0),
- GVREF (ra1, i1));
- GVSET (ra0, i0, res);
+ SCM res = scm_divide (AREF (ra0, i0), AREF (ra1, i1));
+ ASET (ra0, i0, res);
}
break;
}
@@ -693,7 +697,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
SCM args = SCM_EOL;
unsigned long k;
for (k = scm_c_vector_length (ras); k--;)
- args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args);
+ args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args);
h0.impl->vset (&h0, i0, scm_apply_1 (proc, h1.impl->vref (&h1,
i1), args));
}
}
@@ -753,7 +757,7 @@ rafe (SCM ra0, SCM proc, SCM ras)
SCM args = SCM_EOL;
unsigned long k;
for (k = scm_c_vector_length (ras); k--;)
- args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args);
+ args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args);
scm_apply_1 (proc, h0.impl->vref (&h0, i0), args);
}
}
@@ -798,7 +802,16 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2,
0, 0,
unsigned long i;
SCM_VALIDATE_PROC (2, proc);
- if (SCM_I_ARRAYP (ra))
+ if (!scm_is_array (ra))
+ scm_wrong_type_arg_msg (NULL, 0, ra, "array");
+ else if (!SCM_I_ARRAYP (ra))
+ {
+ size_t length = scm_c_array_length (ra);
+ for (i = 0; i < length; ++i)
+ ASET (ra, i, scm_call_1 (proc, scm_from_ulong (i)));
+ return SCM_UNSPECIFIED;
+ }
+ else
{
SCM args = SCM_EOL;
int j, k, kmax = SCM_I_ARRAY_NDIM (ra) - 1;
@@ -823,7 +836,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2,
0, 0,
{
for (j = kmax + 1, args = SCM_EOL; j--;)
args = scm_cons (scm_from_long (vinds[j]), args);
- GVSET (SCM_I_ARRAY_V (ra), i, scm_apply_0 (proc, args));
+ ASET (SCM_I_ARRAY_V (ra), i, scm_apply_0 (proc, args));
i += SCM_I_ARRAY_DIMS (ra)[k].inc;
}
k--;
@@ -842,15 +855,6 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2,
0, 0,
return SCM_UNSPECIFIED;
}
- else if (scm_is_generalized_vector (ra))
- {
- size_t length = scm_c_generalized_vector_length (ra);
- for (i = 0; i < length; i++)
- GVSET (ra, i, scm_call_1 (proc, scm_from_ulong (i)));
- return SCM_UNSPECIFIED;
- }
- else
- scm_wrong_type_arg_msg (NULL, 0, ra, "array");
}
#undef FUNC_NAME
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 98c8075..4401a97 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004,2005,
- * 2006, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ * 2006, 2009, 2010, 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
@@ -379,7 +379,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2,
0, 1,
{
SCM_I_ARRAY_V (ra) = oldra;
old_base = old_min = 0;
- old_max = scm_c_generalized_vector_length (oldra) - 1;
+ old_max = scm_c_array_length (oldra) - 1;
}
inds = SCM_EOL;
@@ -431,7 +431,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2,
0, 1,
if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
{
SCM v = SCM_I_ARRAY_V (ra);
- size_t length = scm_c_generalized_vector_length (v);
+ size_t length = scm_c_array_length (v);
if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd)
return v;
if (s->ubnd < s->lbnd)
@@ -584,14 +584,14 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
return SCM_BOOL_F;
}
}
-
+
{
SCM v = SCM_I_ARRAY_V (ra);
- size_t length = scm_c_generalized_vector_length (v);
+ size_t length = scm_c_array_length (v);
if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS
(ra)->inc)
return v;
}
-
+
sra = scm_i_make_array (1);
SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
@@ -817,15 +817,15 @@ scm_i_print_array (SCM array, SCM port, scm_print_state
*pstate)
}
static SCM
-array_handle_ref (scm_t_array_handle *h, size_t pos)
+array_handle_ref (scm_t_array_handle *hh, size_t pos)
{
- return scm_c_generalized_vector_ref (SCM_I_ARRAY_V (h->array), pos);
+ return scm_c_array_ref_1 (SCM_I_ARRAY_V (hh->array), pos);
}
static void
-array_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
+array_handle_set (scm_t_array_handle *hh, size_t pos, SCM val)
{
- scm_c_generalized_vector_set_x (SCM_I_ARRAY_V (h->array), pos, val);
+ scm_c_array_set_1_x (SCM_I_ARRAY_V (hh->array), val, pos);
}
/* FIXME: should be handle for vect? maybe not, because of dims */
diff --git a/libguile/random.c b/libguile/random.c
index c0b04bc..6df2cd9 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -582,13 +582,13 @@ SCM_DEFINE (scm_random_solid_sphere_x,
"random:solid-sphere!", 1, 1, 0,
scm_random_normal_vector_x (v, state);
vector_scale_x (v,
pow (scm_c_uniform01 (SCM_RSTATE (state)),
- 1.0 / scm_c_generalized_vector_length (v))
+ 1.0 / scm_c_array_length (v))
/ sqrt (vector_sum_squares (v)));
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
-SCM_DEFINE (scm_random_hollow_sphere_x, "random:hollow-sphere!", 1, 1, 0,
+SCM_DEFINE (scm_random_hollow_sphere_x, "random:hollow-sphere!", 1, 1, 0,
(SCM v, SCM state),
"Fills vect with inexact real random numbers\n"
"the sum of whose squares is equal to 1.0.\n"
diff --git a/libguile/uniform.c b/libguile/uniform.c
index f8cd2d3..e81f504 100644
--- a/libguile/uniform.c
+++ b/libguile/uniform.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006,
2009, 2010, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006,
2009, 2010, 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
@@ -87,10 +87,11 @@ scm_is_uniform_vector (SCM obj)
scm_t_array_handle h;
int ret = 0;
- if (scm_is_generalized_vector (obj))
+ if (scm_is_array (obj))
{
- scm_generalized_vector_get_handle (obj, &h);
- ret = SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED (h.element_type);
+ scm_array_get_handle (obj, &h);
+ ret = (scm_array_handle_rank (&h) == 1
+ && SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED (h.element_type));
scm_array_handle_release (&h);
}
return ret;
@@ -102,8 +103,7 @@ scm_c_uniform_vector_length (SCM uvec)
if (!scm_is_uniform_vector (uvec))
scm_wrong_type_arg_msg ("uniform-vector-length", 1, uvec,
"uniform vector");
-
- return scm_c_generalized_vector_length (uvec);
+ return scm_c_array_length (uvec);
}
SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0,
@@ -169,11 +169,11 @@ SCM_DEFINE (scm_uniform_vector_element_size,
"uniform-vector-element-size", 1, 0
#undef FUNC_NAME
SCM
-scm_c_uniform_vector_ref (SCM v, size_t idx)
+scm_c_uniform_vector_ref (SCM v, size_t pos)
{
if (!scm_is_uniform_vector (v))
scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
- return scm_c_generalized_vector_ref (v, idx);
+ return scm_c_array_ref_1 (v, pos);
}
SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
@@ -187,11 +187,11 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref",
2, 0, 0,
#undef FUNC_NAME
void
-scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val)
+scm_c_uniform_vector_set_x (SCM v, size_t pos, SCM val)
{
if (!scm_is_uniform_vector (v))
scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
- scm_c_generalized_vector_set_x (v, idx, val);
+ scm_c_array_set_1_x (v, val, pos);
}
SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
@@ -225,13 +225,14 @@ scm_uniform_vector_elements (SCM uvec,
}
void *
-scm_uniform_vector_writable_elements (SCM uvec,
+scm_uniform_vector_writable_elements (SCM uvec,
scm_t_array_handle *h,
size_t *lenp, ssize_t *incp)
{
void *ret;
- scm_generalized_vector_get_handle (uvec, h);
- /* FIXME nonlocal exit */
+ scm_array_get_handle (uvec, h);
+ if (scm_array_handle_rank (h) != 1)
+ scm_wrong_type_arg_msg (0, SCM_ARG1, uvec, "uniform vector");
ret = scm_array_handle_uniform_writable_elements (h);
if (lenp)
{
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 0b3d57c..9d86371 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -574,12 +574,12 @@
(eqv? 8 (array-ref s2 2))))))
;;;
-;;; uniform-vector-ref
+;;; uniform-vector
;;;
-(with-test-prefix "uniform-vector-ref"
+(with-test-prefix "uniform-vector"
- (with-test-prefix "byte"
+ (with-test-prefix "uniform-vector-ref byte"
(let ((a (make-s8vector 1)))
@@ -594,7 +594,23 @@
(pass-if "-128"
(begin
(array-set! a -128 0)
- (= -128 (uniform-vector-ref a 0)))))))
+ (= -128 (uniform-vector-ref a 0))))))
+
+ (with-test-prefix "shared with rank 1 remain uniform vectors"
+
+ (let ((a #f64(1 2 3 4)))
+
+ (pass-if "change offset"
+ (let ((b (make-shared-array a (lambda (i) (list (+ i 1))) 3)))
+ (and (uniform-vector? b)
+ (= 3 (uniform-vector-length b))
+ (array-equal? b #f64(2 3 4)))))
+
+ (pass-if "change stride"
+ (let ((c (make-shared-array a (lambda (i) (list (* i 2))) 2)))
+ (and (uniform-vector? c)
+ (= 2 (uniform-vector-length c))
+ (array-equal? c #f64(1 3))))))))
;;;
;;; syntax
diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test
index 7c3142d..00de626 100644
--- a/test-suite/tests/ramap.test
+++ b/test-suite/tests/ramap.test
@@ -34,10 +34,22 @@
(with-test-prefix "array-index-map!"
(pass-if (let ((nlst '()))
- (array-index-map! (make-array #f '(1 1))
- (lambda (n)
- (set! nlst (cons n nlst))))
- (equal? nlst '(1)))))
+ (array-index-map! (make-array #f '(1 1))
+ (lambda (n)
+ (set! nlst (cons n nlst))))
+ (equal? nlst '(1)))))
+
+;;;
+;;; array-copy!
+;;;
+
+(with-test-prefix "array-copy!"
+
+ (pass-if "empty arrays"
+ (let* ((b (make-array 0 2 2))
+ (c (make-shared-array b (lambda (i j) (list i j)) 0 2)))
+ (array-copy! #2:0:2() c)
+ (array-equal? #2:0:2() c))))
;;;
;;; array-map!
@@ -94,7 +106,7 @@
(pass-if-exception "closure 0" exception:wrong-num-args
(array-map! (make-array #f 5) (lambda () #f)
- (make-array #f 5)))
+ (make-array #f 5)))
(pass-if "closure 1"
(let ((a (make-array #f 5)))
@@ -103,16 +115,16 @@
(pass-if-exception "closure 2" exception:wrong-num-args
(array-map! (make-array #f 5) (lambda (x y) #f)
- (make-array #f 5)))
+ (make-array #f 5)))
(pass-if "subr_1"
(let ((a (make-array #f 5)))
- (array-map! a length (make-array '(x y z) 5))
- (equal? a (make-array 3 5))))
+ (array-map! a length (make-array '(x y z) 5))
+ (equal? a (make-array 3 5))))
(pass-if-exception "subr_2" exception:wrong-num-args
(array-map! (make-array #f 5) logtest
- (make-array 999 5)))
+ (make-array 999 5)))
(pass-if "subr_2o"
(let ((a (make-array #f 5)))
@@ -144,17 +156,17 @@
(pass-if-exception "closure 0" exception:wrong-num-args
(array-map! (make-array #f 5) (lambda () #f)
- (make-array #f 5) (make-array #f 5)))
+ (make-array #f 5) (make-array #f 5)))
(pass-if-exception "closure 1" exception:wrong-num-args
(array-map! (make-array #f 5) (lambda (x) #f)
- (make-array #f 5) (make-array #f 5)))
+ (make-array #f 5) (make-array #f 5)))
(pass-if "closure 2"
(let ((a (make-array #f 5)))
- (array-map! a (lambda (x y) 'foo)
- (make-array #f 5) (make-array #f 5))
- (equal? a (make-array 'foo 5))))
+ (array-map! a (lambda (x y) 'foo)
+ (make-array #f 5) (make-array #f 5))
+ (equal? a (make-array 'foo 5))))
(pass-if-exception "subr_1" exception:wrong-num-args
(array-map! (make-array #f 5) length
@@ -192,31 +204,31 @@
(let ((a (make-array #f 4)))
(array-map! a + #(1 2 3 4) #(5 6 7 8))
(equal? a #(6 8 10 12))))
-
+
(pass-if "noncompact arrays 1"
(let ((a #2((0 1) (2 3)))
- (c #(0 0)))
+ (c (make-array 0 2)))
(begin
(array-map! c + (array-row a 1) (array-row a 1))
(array-equal? c #(4 6)))))
-
+
(pass-if "noncompact arrays 2"
(let ((a #2((0 1) (2 3)))
- (c #(0 0)))
+ (c (make-array 0 2)))
(begin
(array-map! c + (array-col a 1) (array-col a 1))
(array-equal? c #(2 6)))))
-
+
(pass-if "noncompact arrays 3"
(let ((a #2((0 1) (2 3)))
- (c #(0 0)))
+ (c (make-array 0 2)))
(begin
(array-map! c + (array-col a 1) (array-row a 1))
(array-equal? c #(3 6)))))
-
+
(pass-if "noncompact arrays 4"
(let ((a #2((0 1) (2 3)))
- (c #(0 0)))
+ (c (make-array 0 2)))
(begin
(array-map! c + (array-col a 1) (array-row a 1))
(array-equal? c #(3 6)))))))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-635-g16259ae,
Andy Wingo <=