diff --git a/libguile/array-map.c b/libguile/array-map.c index 2d68f5f4a..938f0a7b9 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -1,6 +1,6 @@ /* Copyright (C) 1996, 1998, 2000, 2001, 2004, 2005, 2006, 2008, 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 * as published by the Free Software Foundation; either version 3 of @@ -63,11 +63,11 @@ static SCM make1array (SCM v, ssize_t inc) { SCM a = scm_i_make_array (1); - SCM_I_ARRAY_BASE (a) = 0; + SCM_I_ARRAY_SET_BASE (a, 0); SCM_I_ARRAY_DIMS (a)->lbnd = 0; SCM_I_ARRAY_DIMS (a)->ubnd = scm_c_array_length (v) - 1; SCM_I_ARRAY_DIMS (a)->inc = inc; - SCM_I_ARRAY_V (a) = v; + SCM_I_ARRAY_SET_V (a, v); return a; } @@ -195,9 +195,9 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what) if (k == kroll) { SCM y = lra; - SCM_I_ARRAY_BASE (va0) = cindk (ra0, vi, kroll); + SCM_I_ARRAY_SET_BASE (va0, cindk (ra0, vi, kroll)); for (z = lva; !scm_is_null (z); z = SCM_CDR (z), y = SCM_CDR (y)) - SCM_I_ARRAY_BASE (SCM_CAR (z)) = cindk (SCM_CAR (y), vi, kroll); + SCM_I_ARRAY_SET_BASE (SCM_CAR (z), cindk (SCM_CAR (y), vi, kroll)); if (! (SCM_UNBNDP (data) ? cproc (va0, lva) : cproc (va0, data, lva))) return 0; --k; @@ -815,7 +815,7 @@ array_compare (scm_t_array_handle *hx, scm_t_array_handle *hy, return 0; i = hx->dims[dim].ubnd - hx->dims[dim].lbnd + 1; - + incx = hx->dims[dim].inc; incy = hy->dims[dim].inc; posx += (i - 1) * incx; @@ -832,11 +832,11 @@ SCM scm_array_equal_p (SCM x, SCM y) { scm_t_array_handle hx, hy; - SCM res; - + SCM res; + scm_array_get_handle (x, &hx); scm_array_get_handle (y, &hy); - + res = scm_from_bool (hx.ndims == hy.ndims && hx.element_type == hy.element_type); @@ -860,7 +860,7 @@ SCM_DEFINE (scm_i_array_equal_p, "array-equal?", 0, 2, 1, { if (SCM_UNBNDP (ra0) || SCM_UNBNDP (ra1)) return SCM_BOOL_T; - + while (!scm_is_null (rest)) { if (scm_is_false (scm_array_equal_p (ra0, ra1))) return SCM_BOOL_F; diff --git a/libguile/arrays.c b/libguile/arrays.c index 702faacbe..9e5715cf1 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -1,6 +1,6 @@ /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004,2005, * 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 * as published by the Free Software Foundation; either version 3 of @@ -29,6 +29,8 @@ #include #include +#include "verify.h" + #include "libguile/_scm.h" #include "libguile/__scm.h" #include "libguile/eq.h" @@ -92,7 +94,7 @@ SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, #undef FUNC_NAME -SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, +SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, (SCM ra), "For each dimension, return the distance between elements in the root vector.") #define FUNC_NAME s_scm_shared_array_increments @@ -112,15 +114,19 @@ SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, } #undef FUNC_NAME +/* FIXME: to avoid this assumption, fix the accessors in arrays.h, + scm_i_make_array, and the array cases in system/vm/assembler.scm. */ + +verify (sizeof (scm_t_array_dim) == 3*sizeof (scm_t_bits)); + +/* Matching SCM_I_ARRAY accessors in arrays.h */ SCM scm_i_make_array (int ndim) { - SCM ra; - ra = scm_cell (((scm_t_bits) ndim << 17) + scm_tc7_array, - (scm_t_bits) scm_gc_malloc (sizeof (scm_i_t_array) + - ndim * sizeof (scm_t_array_dim), - "array")); - SCM_I_ARRAY_V (ra) = SCM_BOOL_F; + SCM ra = scm_words (((scm_t_bits) ndim << 17) + scm_tc7_array, 3 + ndim*3); + SCM_I_ARRAY_SET_V (ra, SCM_BOOL_F); + SCM_I_ARRAY_SET_BASE (ra, 0); + /* dimensions are unset */ return ra; } @@ -139,7 +145,7 @@ scm_i_shap2ra (SCM args) scm_misc_error (NULL, s_bad_spec, SCM_EOL); ra = scm_i_make_array (ndim); - SCM_I_ARRAY_BASE (ra) = 0; + SCM_I_ARRAY_SET_BASE (ra, 0); s = SCM_I_ARRAY_DIMS (ra); for (; !scm_is_null (args); s++, args = SCM_CDR (args)) { @@ -179,7 +185,7 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1, size_t k, rlen = 1; scm_t_array_dim *s; SCM ra; - + ra = scm_i_shap2ra (bounds); SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); s = SCM_I_ARRAY_DIMS (ra); @@ -195,8 +201,7 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1, if (scm_is_eq (fill, SCM_UNSPECIFIED)) fill = SCM_UNDEFINED; - SCM_I_ARRAY_V (ra) = - scm_make_generalized_vector (type, scm_from_size_t (rlen), fill); + SCM_I_ARRAY_SET_V (ra, scm_make_generalized_vector (type, scm_from_size_t (rlen), fill)); if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra)) if (0 == s->lbnd) @@ -217,7 +222,7 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes, scm_t_array_handle h; void *elts; size_t sz; - + ra = scm_i_shap2ra (bounds); SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); s = SCM_I_ARRAY_DIMS (ra); @@ -229,8 +234,7 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes, SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1); rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc; } - SCM_I_ARRAY_V (ra) = - scm_make_generalized_vector (type, scm_from_size_t (rlen), SCM_UNDEFINED); + SCM_I_ARRAY_SET_V (ra, scm_make_generalized_vector (type, scm_from_size_t (rlen), SCM_UNDEFINED)); scm_array_get_handle (ra, &h); @@ -273,7 +277,7 @@ scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len) scm_t_array_dim *s; SCM ra; scm_t_array_handle h; - + ra = scm_i_shap2ra (bounds); SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); s = SCM_I_ARRAY_DIMS (ra); @@ -288,7 +292,7 @@ scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len) if (rlen != len) SCM_MISC_ERROR ("element length and dimensions do not match", SCM_EOL); - SCM_I_ARRAY_V (ra) = scm_c_make_vector (rlen, SCM_UNDEFINED); + SCM_I_ARRAY_SET_V (ra, scm_c_make_vector (rlen, SCM_UNDEFINED)); scm_array_get_handle (ra, &h); memcpy (h.writable_elements, elts, rlen * sizeof(SCM)); scm_array_handle_release (&h); @@ -323,7 +327,7 @@ scm_i_ra_set_contp (SCM ra) SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra); return; } - inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd + inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1); } } @@ -368,7 +372,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, if (SCM_I_ARRAYP (oldra)) { - SCM_I_ARRAY_V (ra) = SCM_I_ARRAY_V (oldra); + SCM_I_ARRAY_SET_V (ra, SCM_I_ARRAY_V (oldra)); old_base = old_min = old_max = SCM_I_ARRAY_BASE (oldra); s = scm_array_handle_dims (&old_handle); k = scm_array_handle_rank (&old_handle); @@ -382,7 +386,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, } else { - SCM_I_ARRAY_V (ra) = oldra; + SCM_I_ARRAY_SET_V (ra, oldra); old_base = old_min = 0; old_max = scm_c_array_length (oldra) - 1; } @@ -398,9 +402,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, ra = scm_make_generalized_vector (scm_array_type (ra), SCM_INUM0, SCM_UNDEFINED); else - SCM_I_ARRAY_V (ra) = - scm_make_generalized_vector (scm_array_type (ra), - SCM_INUM0, SCM_UNDEFINED); + SCM_I_ARRAY_SET_V (ra, scm_make_generalized_vector (scm_array_type (ra), + SCM_INUM0, SCM_UNDEFINED)); scm_array_handle_release (&old_handle); return ra; } @@ -408,7 +411,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, imap = scm_apply_0 (mapfunc, scm_reverse (inds)); i = scm_array_handle_pos (&old_handle, imap); - SCM_I_ARRAY_BASE (ra) = new_min = new_max = i + old_base; + new_min = new_max = i + old_base; + SCM_I_ARRAY_SET_BASE (ra, new_min); indptr = inds; k = SCM_I_ARRAY_NDIM (ra); while (k--) @@ -450,7 +454,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, /* args are RA . DIMS */ -SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, +SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, (SCM ra, SCM args), "Return an array sharing contents with @var{ra}, but with\n" "dimensions arranged in a different order. There must be one\n" @@ -509,8 +513,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, } ndim++; res = scm_i_make_array (ndim); - SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (ra); - SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra); + SCM_I_ARRAY_SET_V (res, SCM_I_ARRAY_V (ra)); + SCM_I_ARRAY_SET_BASE (res, SCM_I_ARRAY_BASE (ra)); for (k = ndim; k--;) { SCM_I_ARRAY_DIMS (res)[k].lbnd = 0; @@ -534,7 +538,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, r->ubnd = s->ubnd; if (r->lbnd < s->lbnd) { - SCM_I_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc; + SCM_I_ARRAY_SET_BASE (res, SCM_I_ARRAY_BASE (res) + (s->lbnd - r->lbnd) * r->inc); r->lbnd = s->lbnd; } r->inc += s->inc; @@ -596,8 +600,8 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, SCM sra = scm_i_make_array (1); SCM_I_ARRAY_DIMS (sra)->lbnd = 0; SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1; - SCM_I_ARRAY_V (sra) = v; - SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra); + SCM_I_ARRAY_SET_V (sra, v); + SCM_I_ARRAY_SET_BASE (sra, SCM_I_ARRAY_BASE (ra)); SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc : 1); return sra; } @@ -760,7 +764,7 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate) scm_intprint (h.ndims, 10, port); if (h.element_type != SCM_ARRAY_ELEMENT_TYPE_SCM) scm_write (scm_array_handle_element_type (&h), port); - + for (i = 0; i < h.ndims; i++) { if (h.dims[i].lbnd != 0) diff --git a/libguile/arrays.h b/libguile/arrays.h index 6045ab65d..5f4059792 100644 --- a/libguile/arrays.h +++ b/libguile/arrays.h @@ -54,23 +54,18 @@ SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst); /* internal. */ -typedef struct scm_i_t_array -{ - SCM v; /* the contents of the array, e.g., a vector or uniform vector. */ - unsigned long base; -} scm_i_t_array; - #define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0) #define SCM_I_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc7_array, a) #define SCM_I_ARRAY_NDIM(x) ((size_t) (SCM_CELL_WORD_0 (x)>>17)) #define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0 (x) & (SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)) -#define SCM_I_ARRAY_MEM(a) ((scm_i_t_array *) SCM_CELL_WORD_1 (a)) -#define SCM_I_ARRAY_V(a) (SCM_I_ARRAY_MEM (a)->v) -#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base) -#define SCM_I_ARRAY_DIMS(a) \ - ((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array))) +#define SCM_I_ARRAY_V(a) SCM_CELL_OBJECT_1 (a) +#define SCM_I_ARRAY_BASE(a) ((size_t) SCM_CELL_WORD_2 (a)) +#define SCM_I_ARRAY_DIMS(a) ((scm_t_array_dim *) SCM_CELL_OBJECT_LOC (a, 3)) + +#define SCM_I_ARRAY_SET_V(a, v) SCM_SET_CELL_OBJECT_1(a, v) +#define SCM_I_ARRAY_SET_BASE(a, base) SCM_SET_CELL_WORD_2(a, base) SCM_INTERNAL SCM scm_i_make_array (int ndim); SCM_INTERNAL int scm_i_print_array (SCM array, SCM port, scm_print_state *pstate); diff --git a/libguile/deprecated.h b/libguile/deprecated.h index ae1fb04c4..d642b7951 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -129,7 +129,6 @@ SCM_DEPRECATED SCM scm_internal_dynamic_wind (scm_t_guard before, #define scm_substring_move_right_x scm_substring_move_right_x__GONE__REPLACE_WITH__scm_substring_move_x #define scm_vtable_index_printer scm_vtable_index_printer__GONE__REPLACE_WITH__scm_vtable_index_instance_printer #define scm_vtable_index_vtable scm_vtable_index_vtable__GONE__REPLACE_WITH__scm_vtable_index_self -typedef scm_i_t_array scm_i_t_array__GONE__REPLACE_WITH__scm_t_array; #ifndef BUILDING_LIBGUILE #define SCM_ASYNC_TICK SCM_ASYNC_TICK__GONE__REPLACE_WITH__scm_async_tick diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index e944e6818..97eade685 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -900,14 +900,15 @@ table, its existing label is used directly." ,(recur (make-uniform-vector-backing-store (uniform-array->bytevector obj) width)))))) + ((array? obj) + `((static-patch! ,label 1 ,(recur (shared-array-root obj))))) (else (error "don't know how to intern" obj)))) (cond ((immediate? obj) #f) ((vhash-assoc obj (asm-constants asm)) => cdr) (else - ;; Note that calling intern may mutate asm-constants and - ;; asm-constant-inits. + ;; Note that calling intern may mutate asm-constants and asm-inits. (let* ((label (gensym "constant")) (inits (intern obj label))) (set-asm-constants! asm (vhash-cons obj label (asm-constants asm))) @@ -1230,6 +1231,7 @@ should be .data or .rodata), and return the resulting linker object. (define tc7-program 69) (define tc7-bytevector 77) (define tc7-bitvector 95) + (define tc7-array 93) (let ((word-size (asm-word-size asm)) (endianness (asm-endianness asm))) @@ -1254,6 +1256,8 @@ should be .data or .rodata), and return the resulting linker object. (* 4 word-size)) ((uniform-vector-backing-store? x) (bytevector-length (uniform-vector-backing-store-bytes x))) + ((array? x) + (* word-size (+ 3 (* 3 (array-rank x))))) (else word-size))) @@ -1310,7 +1314,7 @@ should be .data or .rodata), and return the resulting linker object. (write-immediate asm buf pos #f)) ((string? obj) - (let ((tag (logior tc7-ro-string (ash (string-length obj) 8)))) + (let ((tag (logior tc7-ro-string (ash (string-length obj) 8)))) ; FIXME: unused? (case word-size ((4) (bytevector-u32-set! buf pos tc7-ro-string endianness) @@ -1385,6 +1389,27 @@ should be .data or .rodata), and return the resulting linker object. ;; Need to swap units of element-size bytes (error "FIXME: Implement byte order swap")))) + ((array? obj) + (let-values + ;; array tag + rank + contp flag: see libguile/arrays.h . + (((tag) (logior tc7-array (ash (array-rank obj) 17) (ash 1 16))) + ((bv-set! bvs-set!) + (case word-size + ((4) (values bytevector-u32-set! bytevector-s32-set!)) + ((8) (values bytevector-u64-set! bytevector-s64-set!)) + (else (error "bad word size"))))) + (bv-set! buf pos tag endianness) + (write-immediate asm buf (+ pos word-size) #f) ; root vector (fixed later) + (bv-set! buf (+ pos (* word-size 2)) 0 endianness) ; base + (let lp ((pos (+ pos (* word-size 3))) + (bounds (array-shape obj)) + (incs (shared-array-increments obj))) + (when (pair? bounds) + (bvs-set! buf pos (first (first bounds)) endianness) + (bvs-set! buf (+ pos word-size) (second (first bounds)) endianness) + (bvs-set! buf (+ pos (* word-size 2)) (first incs) endianness) + (lp (+ pos (* 3 word-size)) (cdr bounds) (cdr incs)))))) + (else (error "unrecognized object" obj)))) diff --git a/test-suite/test-suite/lib.scm b/test-suite/test-suite/lib.scm index 749e8cc3a..27620a7b7 100644 --- a/test-suite/test-suite/lib.scm +++ b/test-suite/test-suite/lib.scm @@ -465,6 +465,8 @@ (define-syntax c&e (syntax-rules (pass-if pass-if-equal pass-if-exception) "Run the given tests both with the evaluator and the compiler/VM." + ((_ (pass-if exp)) + (c&e (pass-if "[unnamed test]" exp))) ((_ (pass-if test-name exp)) (begin (pass-if (string-append test-name " (eval)") (primitive-eval 'exp)) diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test index 415f183fe..66316fef6 100644 --- a/test-suite/tests/arrays.test +++ b/test-suite/tests/arrays.test @@ -200,7 +200,7 @@ ;;; array-equal? ;;; -(with-test-prefix "array-equal?" +(with-test-prefix/c&e "array-equal?" (pass-if "#s16(...)" (array-equal? #s16(1 2 3) #s16(1 2 3)))) @@ -212,7 +212,7 @@ (define exception:mapping-out-of-range (cons 'misc-error "^mapping out of range")) ;; per scm_make_shared_array -(with-test-prefix "make-shared-array" +(with-test-prefix/c&e "make-shared-array" ;; this failed in guile 1.8.0 (pass-if "vector unchanged" @@ -283,9 +283,9 @@ ;;; array-contents ;;; -(with-test-prefix "array-contents" +(define (every-two x) (make-shared-array x (lambda (i) (list (* i 2))) 2)) - (define (every-two x) (make-shared-array x (lambda (i) (list (* i 2))) 2)) +(with-test-prefix/c&e "array-contents" (pass-if "simple vector" (let* ((a (make-array 0 4))) @@ -342,30 +342,33 @@ (not (array-contents b)))) ;; FIXME maybe this should be allowed. - #; - (pass-if "broadcast vector -> empty" - (let* ((a (make-array 0 4)) - (b (make-shared-array a (lambda (i j k) (list k)) 0 1 4))) - (if #f #f))) + ;; (pass-if "broadcast vector -> empty" + ;; (let* ((a (make-array 0 4)) + ;; (b (make-shared-array a (lambda (i j k) (list k)) 0 1 4))) + ;; (if #f #f))) (pass-if "broadcast 2-rank I" (let* ((a #2((1 2 3) (4 5 6))) (b (make-shared-array a (lambda (i j) (list 0 j)) 2 3))) (not (array-contents b)))) - (pass-if "broadcast 2-rank I" + (pass-if "broadcast 2-rank II" (let* ((a #2((1 2 3) (4 5 6))) (b (make-shared-array a (lambda (i j) (list i 0)) 2 3))) - (not (array-contents b))))) + (not (array-contents b)))) + + (pass-if "literal array" + (not (not (array-contents #2((1 2 3) (4 5 6))))))) + ;;; ;;; shared-array-root ;;; -(with-test-prefix "shared-array-root" +(define amap1 (lambda (i) (list (* 2 i)))) +(define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j))))) - (define amap1 (lambda (i) (list (* 2 i)))) - (define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j))))) +(with-test-prefix/c&e "shared-array-root" (pass-if "plain vector" (let* ((a (make-vector 4 0)) @@ -395,7 +398,7 @@ (define exception:wrong-type-arg (cons #t "Wrong type")) -(with-test-prefix "transpose-array" +(with-test-prefix/c&e "transpose-array" (pass-if-exception "non array argument" exception:wrong-type-arg (transpose-array 99)) @@ -436,11 +439,11 @@ ;;; array->list ;;; -(with-test-prefix "array->list" - (pass-if-equal '(1 2 3) (array->list #s16(1 2 3))) - (pass-if-equal '(1 2 3) (array->list #(1 2 3))) - (pass-if-equal '((1 2) (3 4) (5 6)) (array->list #2((1 2) (3 4) (5 6)))) - (pass-if-equal '() (array->list #())) +(with-test-prefix/c&e "array->list" + (pass-if-equal "uniform vector" '(1 2 3) (array->list #s16(1 2 3))) + (pass-if-equal "vector" '(1 2 3) (array->list #(1 2 3))) + (pass-if-equal "rank 2 array" '((1 2) (3 4) (5 6)) (array->list #2((1 2) (3 4) (5 6)))) + (pass-if-equal "empty vector" '() (array->list #())) (pass-if-equal "http://bugs.gnu.org/12465 - ok" '(3 4) @@ -531,7 +534,7 @@ ;;; array-in-bounds? ;;; -(with-test-prefix "array-in-bounds?" +(with-test-prefix/c&e "array-in-bounds?" (pass-if (let ((a (make-array #f '(425 425)))) (eq? #f (array-in-bounds? a 0))))) @@ -542,7 +545,7 @@ (with-test-prefix "array-type" - (with-test-prefix "on make-foo-vector" + (with-test-prefix/c&e "on make-foo-vector" (pass-if "bool" (eq? 'b (array-type (make-bitvector 1)))) @@ -728,7 +731,7 @@ ;;; syntax ;;; -(with-test-prefix "syntax" +(with-test-prefix/c&e "syntax" (pass-if "rank and lower bounds" ;; uniform u32 array of rank 2 with index ranges 2..3 and 7..8. @@ -770,7 +773,7 @@ ;;; equal? with vector and one-dimensional array ;;; -(with-test-prefix "equal?" +(with-test-prefix/c&e "equal?" (pass-if "array and non-array" (not (equal? #2f64((0 1) (2 3)) 100))) @@ -805,12 +808,12 @@ ;;; slices as generalized vectors ;;; -(let ((array #2u32((0 1) (2 3)))) - (define (array-row a i) - (make-shared-array a (lambda (j) (list i j)) - (cadr (array-dimensions a)))) - (with-test-prefix "generalized vector slices" - (pass-if (equal? (array-row array 1) - #u32(2 3))) - (pass-if (equal? (array-ref (array-row array 1) 0) - 2)))) +(define (array-row a i) + (make-shared-array a (lambda (j) (list i j)) + (cadr (array-dimensions a)))) + +(with-test-prefix/c&e "generalized vector slices" + (pass-if (equal? (array-row #2u32((0 1) (2 3)) 1) + #u32(2 3))) + (pass-if (equal? (array-ref (array-row #2u32((0 1) (2 3)) 1) 0) + 2)))