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 <[email protected]> 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 <[email protected]> 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 <[email protected]> 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 <[email protected]>. commit 1fadf369b8eb2eec2011707ef1831c01ae134a37 Author: Andy Wingo <[email protected]> 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 <[email protected]> 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 <[email protected]> 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 <[email protected]> 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
