;;;; 25.stk         -- tests for SRFI-25: Multi-dimensional Array Primitives
;;;;
;;;; Copyright © 2021 Jeronimo Pellegrini <j_p@aleph0.info>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program 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 General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; This file is a derivative work from the  implementation of
;;;; this SRFI by Jussi Piitulainen, it is copyrighted as:
;;;;
;;;;;; Copyright (C) Jussi Piitulainen (2001). All Rights Reserved.
;;;;;;
;;;;;; Redistribution and use in source and binary forms, with or without
;;;;;; modification, are permitted provided that the following conditions
;;;;;; are met:
;;;;;; 1. Redistributions of source code must retain the above copyright
;;;;;;    notice, this list of conditions and the following disclaimer.
;;;;;; 2. Redistributions in binary form must reproduce the above copyright
;;;;;;    notice, this list of conditions and the following disclaimer in the
;;;;;;    documentation and/or other materials provided with the distribution.
;;;;;; 3. The name of the authors may not be used to endorse or promote products
;;;;;;    derived from this software without specific prior written permission.
;;;;;;
;;;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
;;;;;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;;;;;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;;;;;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
;;;;;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;;;;;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;;;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;;;;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;;;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;;;;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;;;;
;;;;           Author: Jeronimo Pellegrini [j_p@aleph0.info]
;;;;    Creation date: 29-Mar-2021 22:21 (jpellegrini)

(define (tail n)
  (if (< n (length (past)))
      (list-tail (past) (- (length (past)) n))
      (past)))

;;; Simple tests



(test "srfi-25 1"
      #f
      (not (and (shape)
                (shape -1 -1)
                (shape -1 0)
                (shape -1 1)
                (shape 1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8))))

(test "srfi-25 2"
      #f
      (not (and (make-array (shape))
                (make-array (shape) *)
                (make-array (shape -1 -1))
                (make-array (shape -1 -1) *)
                (make-array (shape -1 1))
                (make-array (shape 1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8 1 2 3 4) *))))

(test "srfi-25 3"
      #f
      (not (and (array (shape) *)
                (array (shape -1 -1))
                (array (shape -1 1) * *)
                (array (shape 1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8) *))))

(test "srfi-25 4.1" 2 (array-rank (shape)))
(test "srfi-25 4.2" 2 (array-rank (shape -1 -1)))
(test "srfi-25 4.3" 2 (array-rank (shape -1 1)))
(test "srfi-25 4.4" 2 (array-rank (shape 1 2 3 4 5 6 7 8)))

(test "srfi-25 5" #t (and (= (array-rank (make-array (shape))) 0)
                          (= (array-rank (make-array (shape -1 -1))) 1)
                          (= (array-rank (make-array (shape -1 1))) 1)
                          (= (array-rank (make-array (shape 1 2 3 4 5 6 7 8))) 4)))

(test "srfi-25 6" #t (and (= (array-rank (array (shape) *)) 0)
                         (= (array-rank (array (shape -1 -1))) 1)
                         (= (array-rank (array (shape -1 1) * *)) 1)
                         (= (array-rank (array (shape 1 2 3 4 5 6 7 8) *)) 4)))

(test "srfi-25 7" #t (and (= (array-start (shape -1 -1) 0) 0)
                          (= (array-start (shape -1 -1) 1) 0)
                          (= (array-start (shape -1 1) 0) 0)
                          (= (array-start (shape -1 1) 1) 0)
                          (= (array-start (shape 1 2 3 4 5 6 7 8) 0) 0)
                          (= (array-start (shape 1 2 3 4 5 6 7 8) 1) 0)))

(test "srfi-25 8" #t (and (= (array-end (shape -1 -1) 0) 1)
                          (= (array-end (shape -1 -1) 1) 2)
                          (= (array-end (shape -1 1) 0) 1)
                          (= (array-end (shape -1 1) 1) 2)
                          (= (array-end (shape 1 2 3 4 5 6 7 8) 0) 4)
                          (= (array-end (shape 1 2 3 4 5 6 7 8) 1) 2)))

(test "srfi-25 9.1" -1 (array-start (make-array (shape -1 -1)) 0))
(test "srfi-25 9.2" -1 (array-start (make-array (shape -1 1)) 0))
(test "srfi-25 9.3"  1 (array-start (make-array (shape 1 2 3 4 5 6 7 8)) 0))
(test "srfi-25 9.4"  3 (array-start (make-array (shape 1 2 3 4 5 6 7 8)) 1))
(test "srfi-25 9.5"  5 (array-start (make-array (shape 1 2 3 4 5 6 7 8)) 2))
(test "srfi-25 9.6"  7 (array-start (make-array (shape 1 2 3 4 5 6 7 8)) 3))

(test "srfi-25 10" #t (and (= (array-end (make-array (shape -1 -1)) 0) -1)
                           (= (array-end (make-array (shape -1 1)) 0) 1)
                           (= (array-end (make-array (shape 1 2 3 4 5 6 7 8)) 0) 2)
                           (= (array-end (make-array (shape 1 2 3 4 5 6 7 8)) 1) 4)
                           (= (array-end (make-array (shape 1 2 3 4 5 6 7 8)) 2) 6)
                           (= (array-end (make-array (shape 1 2 3 4 5 6 7 8)) 3) 8)))

(test "srfi-25 11" #t (and (= (array-start (array (shape -1 -1)) 0) -1)
                           (= (array-start (array (shape -1 1) * *) 0) -1)
                           (= (array-start (array (shape 1 2 3 4 5 6 7 8) *) 0) 1)
                           (= (array-start (array (shape 1 2 3 4 5 6 7 8) *) 1) 3)
                           (= (array-start (array (shape 1 2 3 4 5 6 7 8) *) 2) 5)
                           (= (array-start (array (shape 1 2 3 4 5 6 7 8) *) 3) 7)))

(test "srfi-25 12" #t (and (= (array-end (array (shape -1 -1)) 0) -1)
                           (= (array-end (array (shape -1 1) * *) 0) 1)
                           (= (array-end (array (shape 1 2 3 4 5 6 7 8) *) 0) 2)
                           (= (array-end (array (shape 1 2 3 4 5 6 7 8) *) 1) 4)
                           (= (array-end (array (shape 1 2 3 4 5 6 7 8) *) 2) 6)
                           (= (array-end (array (shape 1 2 3 4 5 6 7 8) *) 3) 8)))

(test "srfi-25 13.1" 'a (array-ref (make-array (shape) 'a)))
(test "srfi-25 13.2" 'b (array-ref (make-array (shape -1 1) 'b) -1))
(test "srfi-25 13.3" 'c (array-ref (make-array (shape -1 1) 'c) 0))
(test "srfi-25 13.4" 'd (array-ref (make-array (shape 1 2 3 4 5 6 7 8) 'd) 1 3 5 7))


(test "srfi-25 14.1" 'a (array-ref (make-array (shape) 'a) '#()))
(test "srfi-25 14.2" 'b (array-ref (make-array (shape -1 1) 'b) '#(-1)))
(test "srfi-25 14.3" 'c (array-ref (make-array (shape -1 1) 'c) '#(0)))
(test "srfi-25 14.4" 'd (array-ref (make-array (shape 1 2 3 4 5 6 7 8) 'd) '#(1 3 5 7)))

(test "srfi-25 15.1" 'a (array-ref (make-array (shape) 'a)
                                   (array (shape 0 0))))
(test "srfi-25 15.2" 'b (array-ref (make-array (shape -1 1) 'b)
                                   (array (shape 0 1) -1)))
(test "srfi-25 15.3" 'c (array-ref (make-array (shape -1 1) 'c)
                                   (array (shape 0 1) 0)))
(test "srfi-25 15.4" 'd (array-ref (make-array (shape 1 2 3 4 5 6 7 8) 'd)
                                   (array (shape 0 4) 1 3 5 7)))

(let ((arr (make-array (shape) 'o)))
  (array-set! arr 'a)
  (test "srfi-25 16.0" 'a (array-ref arr)))

(let ((arr (make-array (shape -1 1) 'o)))
  (array-set! arr -1 'b)
  (array-set! arr 0 'c)
  (test "srfi-25 16.1" 'b (array-ref arr -1))
  (test "srfi-25 16.2" 'c (array-ref arr 0)))

(test "srfi-25 16.3" 'd (let ((arr (make-array (shape 1 2 3 4 5 6 7 8) 'o)))
                          (array-set! arr 1 3 5 7 'd)
                          (array-ref arr 1 3 5 7)))

(test "srfi-25 17.0" 'a (let ((arr (make-array (shape) 'o)))
                          (array-set! arr '#() 'a)
                          (array-ref arr)))

(let ((arr (make-array (shape -1 1) 'o)))
  (array-set! arr '#(-1) 'b)
  (array-set! arr '#(0) 'c)
  (test "srfi-25 17.1" 'b (array-ref arr -1))
  (test "srfi-25 17.2" 'c (array-ref arr 0)))

(test "srfi-25 17.3" 'd (let ((arr (make-array (shape 1 2 3 4 5 6 7 8) 'o)))
                          (array-set! arr '#(1 3 5 7) 'd)
                          (array-ref arr 1 3 5 7)))

(test "srfi-25 18.0" 'a (let ((arr (make-array (shape) 'o)))
                          (array-set! arr 'a)
                          (array-ref arr)))

(let ((arr (make-array (shape -1 1) 'o)))
  (array-set! arr (array (shape 0 1) -1) 'b)
  (array-set! arr (array (shape 0 1)  0) 'c)
  (test "srfi-25 18.1" 'b (array-ref arr -1))
  (test "srfi-25 18.2" 'c (array-ref arr 0)))

(test "srfi-25 18.3" 'd (let ((arr (make-array (shape 1 2 3 4 5 6 7 8) 'o)))
                          (array-set! arr (array (shape 0 4) 1 3 5 7) 'd)
                          (array-ref arr 1 3 5 7)))

;;; Share and change:
;;;
;;;  org     brk     swp            box
;;;
;;;   0 1     1 2     5 6
;;; 6 a b   2 a b   3 d c   0 2 4 6 8: e
;;; 7 c d   3 e f   4 f e
;;; 8 e f

(let* ((org (array (shape 6 9 0 2) 'a 'b 'c 'd 'e 'f))
       (brk (share-array
             org
             (shape 2 4 1 3)
             (lambda (r k)
               (values
                (+ 6 (* 2 (- r 2)))
                (- k 1)))))
       (swp (share-array
             org
             (shape 3 5 5 7)
             (lambda (r k)
               (values
                (+ 7 (- r 3))
                (- 1 (- k 5))))))
       (box (share-array
             swp
             (shape 0 1 2 3 4 5 6 7 8 9)
             (lambda _ (values 4 6))))
       (org-contents (lambda ()
                       (list (array-ref org 6 0) (array-ref org 6 1)
                             (array-ref org 7 0) (array-ref org 7 1)
                             (array-ref org 8 0) (array-ref org 8 1))))
       (brk-contents (lambda ()
                       (list (array-ref brk 2 1) (array-ref brk 2 2)
                             (array-ref brk 3 1) (array-ref brk 3 2))))
       (swp-contents (lambda ()
                       (list (array-ref swp 3 5) (array-ref swp 3 6)
                             (array-ref swp 4 5) (array-ref swp 4 6))))
       (box-contents (lambda ()
                       (list (array-ref box 0 2 4 6 8)))))
  (test "srfi-25 19.1"  '(a b c d e f) (org-contents))
  (test "srfi-25 19.2"  '(a b e f) (brk-contents))
  (test "srfi-25 19.3"  '(d c f e) (swp-contents))
  (test "srfi-25 19.4"  '(e) (box-contents))
 (array-set! org 6 0 'x)
  (test "srfi-25 19.5"  '(x b c d e f) (org-contents))
  (test "srfi-25 19.6"  '(x b e f) (brk-contents))
  (test "srfi-25 19.7"  '(d c f e) (swp-contents))
  (test "srfi-25 19.8"  '(e) (box-contents))
 (array-set! brk 3 1 'y)
  (test "srfi-25 19.9"  '(x b c d y f) (org-contents))
  (test "srfi-25 19.10"  '(x b y f) (brk-contents))
  (test "srfi-25 19.11"  '(d c f y) (swp-contents))
  (test "srfi-25 19.12"  '(y) (box-contents))
 (array-set! swp 4 5 'z)
  (test "srfi-25 19.13"  '(x b c d y z) (org-contents))
  (test "srfi-25 19.14"  '(x b y z) (brk-contents))
  (test "srfi-25 19.15"  '(d c z y) (swp-contents))
  (test "srfi-25 19.16"  '(y) (box-contents))
 (array-set! box 0 2 4 6 8 'e)
  (test "srfi-25 19.17"  '(x b c d e z) (org-contents))
  (test "srfi-25 19.18"  '(x b e z) (brk-contents))
  (test "srfi-25 19.19"  '(d c z e) (swp-contents))
  (test "srfi-25 19.20"  '(e) (box-contents)))

;;; Check that arrays copy the shape specification

(test "srfi-25 20" #t (let ((shp (shape 10 12)))
                        (let ((arr (make-array shp))
                              (ars (array shp * *))
                              (art (share-array (make-array shp) shp (lambda (k) k))))
                          (array-set! shp 0 0 '?)
                          (array-set! shp 0 1 '!)
                          (and (= (array-rank shp) 2)
                               (= (array-start shp 0) 0)
                               (= (array-end shp 0) 1)
                               (= (array-start shp 1) 0)
                               (= (array-end shp 1) 2)
                               (eq? (array-ref shp 0 0) '?)
                               (eq? (array-ref shp 0 1) '!)
                               (= (array-rank arr) 1)
                               (= (array-start arr 0) 10)
                               (= (array-end arr 0) 12)
                               (= (array-rank ars) 1)
                               (= (array-start ars 0) 10)
                               (= (array-end ars 0) 12)
                               (= (array-rank art) 1)
                               (= (array-start art 0) 10)
                               (= (array-end art 0) 12)))))

;;; Check that index arrays work even when they share
;;;
;;; arr       ixn
;;;   5  6      0 1
;;; 4 nw ne   0 4 6
;;; 5 sw se   1 5 4

(let ((arr (array (shape 4 6 5 7) 'nw 'ne 'sw 'se))
      (ixn (array (shape 0 2 0 2) 4 6 5 4)))
  (let ((col0 (share-array
               ixn
               (shape 0 2)
               (lambda (k)
                 (values k 0))))
        (row0 (share-array
               ixn
               (shape 0 2)
               (lambda (k)
                 (values 0 k))))
        (wor1 (share-array
               ixn
               (shape 0 2)
               (lambda (k)
                 (values 1 (- 1 k)))))
        (cod (share-array
              ixn
              (shape 0 2)
              (lambda (k)
                (case k
                  ((0) (values 1 0))
                  ((1) (values 0 1))))))
        (box (share-array
              ixn
              (shape 0 2)
              (lambda (k)
                (values 1 0)))))
   (test "srfi-25 21.1" 'nw (array-ref arr col0))
   (test "srfi-25 21.2" 'ne (array-ref arr row0))
   (test "srfi-25 21.3" 'nw (array-ref arr wor1))
   (test "srfi-25 21.4" 'se (array-ref arr cod))
   (test "srfi-25 21.5" 'sw (array-ref arr box))
   (array-set! arr col0 'ul)
   (array-set! arr row0 'ur)
   (array-set! arr cod 'lr)
   (array-set! arr box 'll)
   (test "srfi-25 21.6" 'ul (array-ref arr 4 5))
   (test "srfi-25 21.7" 'ur (array-ref arr 4 6))
   (test "srfi-25 21.8" 'll (array-ref arr 5 5))
   (test "srfi-25 21.9" 'lr (array-ref arr 5 6))
   (array-set! arr wor1 'xx)
    (test "srfi-25 21.10" 'xx (array-ref arr 4 5))))


;; ;;; Check that shape arrays work even when they share
;; ;;;
;; ;;; arr             shp       shq       shr       shs
;; ;;;    1  2  3  4      0  1      0  1      0  1      0  1
;; ;;; 1 10 12 16 20   0 10 12   0 12 20   0 10 10   0 12 12
;; ;;; 2 10 11 12 13   1 10 11   1 11 13   1 11 12   1 12 12
;; ;;;                                     2 12 16
;; ;;;                                     3 13 20

(let ((arr (array (shape 1 3 1 5) 10 12 16 20 10 11 12 13)))
  (let ((shp (share-array
              arr
              (shape 0 2 0 2)
              (lambda (r k)
                (values (+ r 1) (+ k 1)))))
        (shq (share-array
              arr
              (shape 0 2 0 2)
              (lambda (r k)
                (values (+ r 1) (* 2 (+ 1 k))))))
        (shr (share-array
              arr
              (shape 0 4 0 2)
              (lambda (r k)
                (values (- 2 k) (+ r 1)))))
        (shs (share-array
              arr
              (shape 0 2 0 2)
              (lambda (r k)
                (values 2 3)))))
    (let ((arr-p (make-array shp)))
      (test "srfi-25 22.1" 2 (array-rank arr-p))
      (test "srfi-25 22.2" 10 (array-start arr-p 0))
      (test "srfi-25 22.3" 12 (array-end arr-p 0))
      (test "srfi-25 22.4" 10 (array-start arr-p 1))
      (test "srfi-25 22.5" 11 (array-end arr-p 1)))
    (let ((arr-q (array shq * * * *  * * * *  * * * *  * * * *)))
      (test "srfi-25 22.6" 2  (array-rank arr-q))
      (test "srfi-25 22.7" 12 (array-start arr-q 0))
      (test "srfi-25 22.8" 20 (array-end arr-q 0))
      (test "srfi-25 22.9" 11 (array-start arr-q 1))
      (test "srfi-25 22.10" 13 (array-end arr-q 1)))
    (let ((arr-r (share-array
                  (array (shape) *)
                  shr
                  (lambda _ (values)))))
      (test "srfi-25 22.11" 4  (array-rank arr-r))
      (test "srfi-25 22.12" 10 (array-start arr-r 0))
      (test "srfi-25 22.13" 10 (array-end arr-r 0))
      (test "srfi-25 22.14" 11 (array-start arr-r 1))
      (test "srfi-25 22.15" 12 (array-end arr-r 1))
      (test "srfi-25 22.16" 12 (array-start arr-r 2))
      (test "srfi-25 22.17" 16 (array-end arr-r 2))
      (test "srfi-25 22.18" 13 (array-start arr-r 3))
      (test "srfi-25 22.19" 20 (array-end arr-r 3)))
    (let ((arr-s (make-array shs)))
      (test "srfi-25 22.20" 2  (array-rank arr-s))
      (test "srfi-25 22.21" 12 (array-start arr-s 0))
      (test "srfi-25 22.22" 12 (array-end arr-s 0))
      (test "srfi-25 22.23" 12 (array-start arr-s 1))
      (test "srfi-25 22.24" 12 (array-end arr-s 1)))))

(let ((super (array (shape 4 7 4 7)
                    1 * *
                    * 2 *
                    * * 3))
      (subshape (share-array
                 (array (shape 0 2 0 3)
                        * 4 *
                        * 7 *)
                 (shape 0 1 0 2)
                 (lambda (r k)
                   (values k 1)))))
  (let ((sub (share-array super subshape (lambda (k) (values k k)))))
    ;;(array-equal? subshape (shape 4 7))
    (test "srfi-25 23.1" 2 (array-rank subshape))
    (test "srfi-25 23.2" 0 (array-start subshape 0))
    (test "srfi-25 23.3" 1 (array-end subshape 0))
    (test "srfi-25 23.4" 0 (array-start subshape 1))
    (test "srfi-25 23.5" 2 (array-end subshape 1))
    (test "srfi-25 23.6" 4 (array-ref subshape 0 0))
    (test "srfi-25 23.7" 7 (array-ref subshape 0 1))
    ;;(array-equal? sub (array (shape 4 7) 1 2 3))
    (test "srfi-25 24.1" 1 (array-rank sub))
    (test "srfi-25 24.2" 4 (array-start sub 0))
    (test "srfi-25 24.3" 7 (array-end sub 0))
    (test "srfi-25 24.4" 1 (array-ref sub 4))
    (test "srfi-25 24.5" 2 (array-ref sub 5))
    (test "srfi-25 24.6" 3 (array-ref sub 6))))


;;;
;;; EXTRA TESTS  -- jpellegrini
;;;

(let ((a (make-array (shape 1 2 3 4 5 6) -1)))
  (test/error "srfi-25 jp 1"    (array-start a -1))
  (test/error "srfi-25 jp 2"    (array-start a  3))
  (test/error "srfi-25 jp 3"    (array-end a   -1))
  (test/error "srfi-25 jp 4"    (array-end a    3))
  (test       "srfi-25 jp 5"  1 (array-start a 0))
  (test       "srfi-25 jp 6"  3 (array-start a 1))
  (test       "srfi-25 jp 7"  5 (array-start a 2))
  (test       "srfi-25 jp 8"  2 (array-end a 0))
  (test       "srfi-25 jp 9"  4 (array-end a 1))
  (test       "srfi-25 jp 10" 6 (array-end a 2)))

;; from the SRFI text:

(test "srfi-25 jp 11"
      'cuatro
      (array-ref (array (shape 0 2 0 3)
                        'uno 'dos 'tres
                        'cuatro 'cinco 'seis)
                 1 0))

(test "srfi-25 jp 12"
      '(3 1 4)
       (let ((a (array (shape 4 7 1 2) 3 1 4)))
         (list (array-ref a 4 1)
               (array-ref a (vector 5 1))
               (array-ref a (array (shape 0 2)
                                   6 1)))))

(test "srfi-25 jp 13"
      'huuhkaja
      (let ((a (make-array
                (shape 4 5 4 5 4 5))))
        (array-set! a 4 4 4 'huuhkaja)
        (array-ref a 4 4 4)))

;; test row-major order, and array-ref corner cases:
(let ((a (array (shape 0 2 0 3 0 4)
                ;; (0 i j)
                -1  -2  -3  -4
                -5  -6  -7  -8
                -9 -10 -11 -12

                ;; (1 k j)
                -13 -14 -15 -16
                -17 -18 -19 -20
                -21 -22 -23 -24))
      (v -1))
  (dotimes (i 2)
    (dotimes (j 3)
      (dotimes (k 4)
        (test "srfi-25 jp 14.loop"
              v
              (array-ref a i j k))
        (set! v (- v 1))))))


(let ((a (array (shape 1 4 1 4 2 6)
                ;; (1 i j)
                -1  -2  -3  -4
                -5  -6  -7  -8
                -9 -10 -11 -12

                ;; (2 k j)
                -13 -14 -15 -16
                -17 -18 -19 -20
                -21 -22 -23 -24

                ;; (3 k j)
                -25 -26 -27 -28
                -29 -30 -31 -32
                -33 -34 -35 -36)))
  ;;
  ;;       s
  ;;
  ;;    -13 -15
  ;; r  -17 -19
  ;;    -21 -23
  ;;
  (let ((b (share-array a
                        (shape 3 6  2 4)
                        (lambda (r s)

                          (values 2
                                  (- r 2)        ;; r in {3, 4, 5} -> {1, 2, 3}
                                  (- (* 2 s) 2)  ;; s in {2, 3}    -> {2, 4}
                                  )))))
    (test "srfi-25 jp 15.share.1" -13 (array-ref b 3 2))
    (test "srfi-25 jp 15.share.2" -15 (array-ref b 3 3))
    (test "srfi-25 jp 15.share.3" -17 (array-ref b 4 2))
    (test "srfi-25 jp 15.share.4" -19 (array-ref b 4 3))
    (test "srfi-25 jp 15.share.5" -21 (array-ref b 5 2))
    (test "srfi-25 jp 15.share.6" -23 (array-ref b 5 3))))

(let* ((i (array
           (shape 0 4 0 4)
           1 2 3 4
           5 6 7 8
           9 10 11 12
           13 14 15 16))
       (d (share-array i
                       (shape 0 4)
                       (lambda (k)
                         (values k k)))))
  (test "srfi-25 jp 16.share.1" 11 (array-ref d 2))
  (test "srfi-25 jp 16.share.2" 11 (array-ref d 2))
  (test "srfi-25 jp 16.share.3" 11 (array-ref d 2))
  (test "srfi-25 jp 16.share.4" 11 (array-ref d 2)))




(define orig (array (shape 0 2 0 3) -1 -2 -3 -4 -5 -6))
(test "srfi-25 jp 17.share.1" #f (shared-array? orig))
(test "srfi-25 jp 17.share.2" 0  (array-share-count orig))
(define one (share-array orig
                         (shape 1 3 1 4)
                         (lambda (x y) (values (- x 1) (- y 1)))))
(test "srfi-25 jp 17.share.3" #t (shared-array? orig))
(test "srfi-25 jp 17.share.4" 1  (array-share-count orig))
(test "srfi-25 jp 17.share.5" #t (shared-array? one))
(test "srfi-25 jp 17.share.6" -1 (array-share-count one))
(define two (share-array orig
                         (shape 0 2 0 3)
                         (lambda (x y) (values x x))))
(test "srfi-25 jp 17.share.7" #t (shared-array? orig))
(test "srfi-25 jp 17.share.8" 2  (array-share-count orig))
(test "srfi-25 jp 17.share.9" #t (shared-array? one))
(test "srfi-25 jp 17.share.10" -1 (array-share-count one))
(test "srfi-25 jp 17.share.11" #t (shared-array? two))
(test "srfi-25 jp 17.share.12" -1 (array-share-count two))
(define three (share-array one
                           (shape 0 2 0 3)
                           (lambda (x y) (values 2 (+ y 1)))))
(test "srfi-25 jp 17.share.13" #t (shared-array? orig))
(test "srfi-25 jp 17.share.14" 3  (array-share-count orig))
(test "srfi-25 jp 17.share.15" #t (shared-array? one))
(test "srfi-25 jp 17.share.16" -1 (array-share-count one))
(test "srfi-25 jp 17.share.17" #t (shared-array? two))
(test "srfi-25 jp 17.share.18" -1 (array-share-count two))
(test "srfi-25 jp 17.share.19" #t (shared-array? three))
(test "srfi-25 jp 17.share.20" -1 (array-share-count three))
;;
;; Ok, so it seems that we can't force the GC to collect the
;; unreachable arrays at the time we awnt it to... So these
;; tests won't work:
;;
;; (set! two #f)
;; (gc)
;; (thread-sleep! 1)
;; (test "srfi-25 jp 17.share.21" #t (shared-array? orig))
;; (test "srfi-25 jp 17.share.22" 2  (array-share-count orig))
;; (test "srfi-25 jp 17.share.23" #t (shared-array? one))
;; (test "srfi-25 jp 17.share.24" -1 (array-share-count one))
;; (test "srfi-25 jp 17.share.25" #t (shared-array? three))
;; (test "srfi-25 jp 17.share.26" -1 (array-share-count three))
;; (set! one #f)
;; (set! three #f)
;; (gc)
;; (thread-sleep! 1)
;; (test "srfi-25 jp 17.share.27" #f (shared-array? orig))
;; (test "srfi-25 jp 17.share.28" 0  (array-share-count orig))

(let ((orig (array (shape 0 2 0 3) -1 -2 -3 -4 -5 -6)))
  (let ((new (array-copy orig)))
    (test "srfi-25 jp 18.copy.1"
          '(-1 -2 -3
            -4 -5 -6)
          (array->list new))))

(let ((orig (array (shape 0 2 0 3) -1 -2 -3 -4 -5 -6)))
  (let ((sh (share-array orig (shape 0 3 0 2) (lambda (x y) (values y x)))))
    (let ((cp (array-copy sh)))
      (test "srfi-25 jp 18.copy.2"
            '(-1 -4
              -2 -5
              -3 -6)
          (array->list cp))
      (test "srfi-25 jp 18.copy.3" #t (shared-array? orig))
      (test "srfi-25 jp 18.copy.4" #t (shared-array? sh))
      (test "srfi-25 jp 18.copy.5" #f (shared-array? cp))
      (test "srfi-25 jp 18.copy.6"  1 (array-share-count orig))
      (test "srfi-25 jp 18.copy.7" -1 (array-share-count sh))
      (test "srfi-25 jp 18.copy.8"  0 (array-share-count cp)))))

(let ((orig (array (shape 0 2 0 3) -1 -2 -3 -4 -5 -6)))
  (let ((sh (share-array orig (shape 0 3 0 2) (lambda (x y) (values y x)))))
    (let ((cp (array-copy+share sh)))
            (test "srfi-25 jp 18.copy.9"  #f (shared-array? orig))
            (test "srfi-25 jp 18.copy.10" #t (shared-array? sh))
            (test "srfi-25 jp 18.copy.11" #t (shared-array? cp))
            (test "srfi-25 jp 18.copy.12"  0 (array-share-count orig))
            (test "srfi-25 jp 18.copy.13" -1 (array-share-count sh))
            (test "srfi-25 jp 18.copy.14" -1 (array-share-count cp)))))

(let ((orig (array (shape 0 2 0 3) -1 -2 -3 -4 -5 -6)))
  (test "srfi-25 jp 19.shape.1"
        '(0 2 0 3)
        (array->list (array-shape orig))))


(define-syntax push-it!
  (syntax-rules ()
    ((_ e lst)
     (set! lst (cons e lst)))))

(let ((shp (shape 1 3 10 12)))
  (let ((res '()))
    (shape-for-each shp
                    (lambda (x y) (push-it! (list x y) res)))
    (test "srfi-25 jp 20.shape-for-each.1"
          '( (1 10) (1 11) (2 10)  (2 11) )
          (reverse res)))

  (let ((res '())
        (vec (make-vector 2 'unused)))
    (shape-for-each shp
                    (lambda (v) (push-it! (list (vector-ref v 0)
                                           (vector-ref v 1)) res))
                    vec)
    (test "srfi-25 jp 20.shape-for-each.2"
          '( (1 10) (1 11) (2 10)  (2 11) )
          (reverse res)))

  (let ((res '())
        (arr (make-array (shape 0 2) 'unused)))
    (shape-for-each shp
                    (lambda (a) (push-it! (list (array-ref a 0)
                                           (array-ref a 1)) res))
                    arr)
    (test "srfi-25 jp 20.shape-for-each.3"
          '( (1 10) (1 11) (2 10)  (2 11) )
          (reverse res))))


(let ((shp (shape 1 3 10 12)))
  (let ((arr2 (make-array shp 'x)))
    (let ((res '()))
      (array-for-each-index arr2
                            (lambda (x y) (push-it! (list x y) res)))
      (test "srfi-25 jp 20.array-for-each-index.1"
            '( (1 10) (1 11) (2 10)  (2 11) )
            (reverse res)))

  (let ((res '())
        (vec (make-vector 2 'unused)))
    (array-for-each-index arr2
                    (lambda (v) (push-it! (list (vector-ref v 0)
                                           (vector-ref v 1)) res))
                    vec)
    (test "srfi-25 jp 20.array-for-each-index.2"
          '( (1 10) (1 11) (2 10)  (2 11) )
          (reverse res)))

  (let ((res '())
        (arr (make-array (shape 0 2) 'unused)))
    (array-for-each-index arr2
                    (lambda (a) (push-it! (list (array-ref a 0)
                                           (array-ref a 1)) res))
                    arr)
    (test "srfi-25 jp 20.array-for-each-index.3"
          '( (1 10) (1 11) (2 10)  (2 11) )
          (reverse res)))))


(test "srfi-25 jp 21.size.1" 24 (array-size (make-array (shape -2 2 -3 3) 'x)))
(test "srfi-25 jp 21.size.2"  0 (array-size (make-array (shape  2 2 -3 3) 'x)))
(test "srfi-25 jp 21.size.3"  1 (array-size (make-array (shape) 'x)))
(test "srfi-25 jp 21.size.4"  1 (array-size (make-array (shape))))

(let ((orig (array (shape 0 2 0 3) -1 -2 -3 -4 -5 -6)))
  (let ((sh (share-array orig (shape 0 3 0 2) (lambda (x y) (values y x)))))
    (let ((cp (array-copy sh)))
      (test "srfi-25 jp 21.size.5" 6 (array-size orig))
      (test "srfi-25 jp 21.size.6" 6 (array-size sh))
      (test "srfi-25 jp 21.size.7" 6 (array-size cp)))))


(let* ((a (make-array (shape 0 2) 'a))
       (b (make-array (shape 0 2) (array-copy a)))
       (c (array (shape 0 2) a b)))
  (array-set! a 1 'x)
  (test "srfi-25 jp 22.array->list.1" '(a x) (array->list a))
  (test "srfi-25 jp 22.array->list.2" 'a (array-ref (car (array->list b)) 1))
  (test "srfi-25 jp 22.array->list.3" 'x (array-ref (car (array->list c)) 1))
  (test "srfi-25 jp 22.array->list.4" 'a (array-ref (car (array->list c)) 0))
  (test "srfi-25 jp 22.array->list.5" 'a (array-ref
                                          (array-ref (cadr (array->list c)) 0)
                                          1)))

(let* ((a (make-array (shape 0 2) 'a))
       (b (make-array (shape 0 2) (array-copy a)))
       (c (array (shape 0 2) a b)))
  (array-set! a 1 'x)
  (test "srfi-25 jp 23.array->vector.1" '#(a x) (array->vector a))
  (test "srfi-25 jp 23.array->vector.2" 'a (array-ref (vector-ref (array->vector b) 0) 1))
  (test "srfi-25 jp 23.array->vector.3" 'x (array-ref (vector-ref (array->vector c) 0) 1))
  (test "srfi-25 jp 23.array->vector.4" 'a (array-ref (vector-ref (array->vector c) 0) 0))
  (test "srfi-25 jp 23.array->vector.5" 'a (array-ref
                                          (array-ref (vector-ref (array->vector c) 1) 0)
                                          1)))


(let ((a (tabulate-array  (shape 2 4 2 5)
                          (lambda (x y) (* x y)))))
  (test "srfi 25 jp 24.tabulate-array 1" '(2 4 2 5) (array->list (array-shape a)))
  (test "srfi 25 jp 24.tabulate-array 2" '(4 6 8 6 9 12) (array->list a)))

(let ((v (make-vector 2 'x)))
  (let ((a (tabulate-array  (shape 2 4 2 5)
                            (lambda (x) (* (vector-ref x 0) (vector-ref x 1)))
                            v)))
  (test "srfi 25 jp 24.tabulate-array 3" '(2 4 2 5) (array->list (array-shape a)))
  (test "srfi 25 jp 24.tabulate-array 4" '(4 6 8 6 9 12) (array->list a))))

;; REALLY EXTRA -- it seems that nobody else supports this:
(let ((a-ind (array (shape 0 2) 'x 'y)))
  (let ((a (tabulate-array  (shape 2 4 2 5)
                            (lambda (x) (* (array-ref x 0) (array-ref x 1)))
                            a-ind)))
  (test "srfi 25 jp 24.tabulate-array 3" '(2 4 2 5) (array->list (array-shape a)))
  (test "srfi 25 jp 24.tabulate-array 4" '(4 6 8 6 9 12) (array->list a))))


(let ((a (array (shape 0 2 0 3)
                -1 -2 -3
                -4 -5 -6)))
  (let ((b (array-map (lambda (x) (* x x)) a)))
    (test "srfi 25 jp 25.array-map.1" '(0 2 0 3) (array->list (array-shape b)))
    (test "srfi 25 jp 25.array-map.2" '(1 4 9 16 25 36) (array->list b))))

(let ((a (array (shape 0 2 0 3)
                -1 -2 -3
                -4 -5 -6))
      (b (array (shape 0 2 0 3)
                -1  1 -1
                -2  2 -2)))
  (let ((c (array-map (lambda (x y) (* x y)) a b)))
    (test "srfi 25 jp 25.array-map.3" '(0 2 0 3) (array->list (array-shape c)))
    (test "srfi 25 jp 25.array-map.4" '(1 -2 3 8 -10 12) (array->list c))))


(let ((a (array (shape 0 2 0 3)
                -1 -2 -3
                -4 -5 -6)))
  (let ((b (make-array (array-shape a) 'x)))
    (array-map! b (lambda (x) (* x x)) a)
    (test "srfi 25 jp 25.array-map!.1" '(0 2 0 3) (array->list (array-shape b)))
    (test "srfi 25 jp 25.array-map!.2" '(1 4 9 16 25 36) (array->list b))))

(let ((a (array (shape 0 2 0 3)
                -1 -2 -3
                -4 -5 -6))
      (b (array (shape 0 2 0 3)
                -1  1 -1
                -2  2 -2)))
  (let ((c (make-array (array-shape b) 'z)))
    (array-map! c (lambda (x y) (* x y)) a b)
     (test "srfi 25 jp 25.array-map!.3" '(0 2 0 3) (array->list (array-shape c)))
     (test "srfi 25 jp 25.array-map!.4" '(1 -2 3 8 -10 12) (array->list c))))

(unless (eq? (%thread-system)  'none)
  ;; create 50 threads; each thread creates 20 arrays sharing content with a single
  ;; array.
  ;; then:
  ;; - each thread checks that its arrays are shared and have -1 share-count
  ;; - after joining all threads, we check that the original array is shared
  ;;   and its shared count is exactly the
  
  (let* ((thread-num 50)
         (arrays-per-thread 20)
         (t '())
         (orig (make-array (shape 0 2 0 3) 'unused))
         (a (make-array (shape 0 thread-num 0 arrays-per-thread) #f)))
    (dotimes (i thread-num)
             (push-it! (make-thread (lambda ()
                                   (dotimes (j arrays-per-thread)
                                            (array-set! a i j (share-array orig
                                                                           (shape 0 2 0 3)
                                                                           (lambda (x y) (values x y)))))
                                   (dotimes (j arrays-per-thread)
                                            (test "srfi 25 jp 25.threads.3"
                                                  #t
                                                  (shared-array? (array-ref a i j)))
                                            (test "srfi 25 jp 25.threads.4"
                                                  -1
                                                  (array-share-count (array-ref a i j))))))
                    t))
    (for-each thread-start! t)
    (for-each thread-join! t)
    (test "srfi 25 jp 25.threads.1"
          (* thread-num arrays-per-thread)
          (array-share-count orig))
    (test "srfi 25 jp 25.threads.2" #t (shared-array? orig))))


(test "srfi-25 26.shape.1" #t (shape? (shape)))
(test "srfi-25 26.shape.2" #t (shape? (shape 0 0)))
(test "srfi-25 26.shape.3" #t (shape? (shape 0 1)))
(test "srfi-25 26.shape.4" #t (shape? (shape 1 10 -10 1)))

(test "srfi-25 26.array.1" #t (array? (make-array (shape) #eof)))
(test "srfi-25 26.array.2" #t (array? (make-array (shape 0 0))))
(test "srfi-25 26.array.3" #t (array? (make-array (shape 0 1) #eof)))
(test "srfi-25 26.array.4" #t (array? (make-array (shape 1 10 -10 1) #eof)))

(test "srfi-25 26.array.5" #t (array? (array (shape) #eof)))
(test "srfi-25 26.array.6" #t (array? (array (shape 0 0))))
(test "srfi-25 26.array.7" #t (array? (array (shape 0 1) #eof)))
(test "srfi-25 26.array.8" #t (array? (array (shape 1 3 -3 1)
                                             -1 -2 -3 -4 -5 -6 -7 -8)))

(define (mult a b)
  (let ((rows (array-end a 0))
        (cols (array-end b 1))
        (x    (array-end a 1)))
    (let ((c (make-array (shape 0 rows 0 cols) 0)))
      (dotimes (i rows)
        (dotimes (j cols)
          (dotimes (k x)
            (array-set! c i j
                        (+ (array-ref c i j)
                           (* (array-ref a i k)
                              (array-ref b k j)))))))
      c)))

(let ((a (array (shape 0 2 0 3)
                1 -2 0
                4  1 1))
      (b (array (shape 0 3 0 2)
                0  0
                2  2
                3 -1)))
  (let ((c (mult a b)))
    (test "srfi-25 jp.matrix-mult.1" '(0 2 0 2) (array->list (array-shape c)))
    (test "srfi-25 jp.matrix-mult.2" '(-4 -4 5 1) (array->list c))))


;; some tests for the reader.
;;
(test "srfi-25 jp.reader.1" #t (array? (read-from-string "#,(<array> ())")))
(test "srfi-25 jp.reader.2" 0 (array-rank (read-from-string "#,(<array> ())")))
(test "srfi-25 jp.reader.3" 2 (array-rank (array-shape (read-from-string "#,(<array> ())"))))
(test "srfi-25 jp.reader.4" #f (shared-array? (read-from-string "#,(<array> ())")))

(test "srfi-25 jp.reader.4" #t (array? (read-from-string "#,(<array> (0 0 1 2))")))
(test "srfi-25 jp.reader.5" 2 (array-rank (read-from-string "#,(<array> (0 0 1 2))")))
(test "srfi-25 jp.reader.6" 2 (array-rank (array-shape (read-from-string "#,(<array> (0 0 1 2))"))))
(test "srfi-25 jp.reader.7" #f (shared-array? (read-from-string "#,(<array> (0 0 1 2))")))

(test "srfi-25 jp.reader.7" #t (array? (read-from-string "#,(<array> (0 1 1 3) -1 -2)")))
(test "srfi-25 jp.reader.8" 2 (array-rank (array-shape (read-from-string "#,(<array> (0 1 1 3) -1 -2)"))))
(test "srfi-25 jp.reader.9" 2 (array-rank (read-from-string "#,(<array> (0 1 1 3) -1 -2)")))
(test "srfi-25 jp.reader.10" #f (shared-array? (read-from-string "#,(<array> (0 1 1 3) -1 -2)")))

(test "srfi-25 jp.reader.11" #t (array? (read-from-string "#,(<array> (0 1 1 3 -2 0) -1 -2 -3 -4)")))
(test "srfi-25 jp.reader.12"
      '(-1 -2 -3 -4)
      (array->list (read-from-string "#,(<array> (0 1 1 3 -2 0) -1 -2 -3 -4)")))

(test "srfi-25 jp.reader.13" 42 (array-ref (read-from-string "#,(<array> () 42)")))
(test/error "srfi-25 jp.reader.14" (array-ref (read-from-string "#,(<array> ())")))             ;; no default value
(test/error "srfi-25 jp.reader.15" (array-ref (read-from-string "#,(<array> (0 0 1 2))") 0 1)) ;; no possible indices


(test "srfi-25 eg.reader.1" #t (equal? (read-from-string "#,(<array> ())")
                                       (array (shape))))
(test "srfi-25 eg.reader.2" #t (equal? (read-from-string "#,(<array> (0 1 1 3) -1 -2)")
                                       (array (shape 0 1 1 3) -1 -2)))

(test "srfi-25 eg.reader.3" #t (equal? (read-from-string "#,(<array> (0 1 1 3 -2 0) -1 -2 -3 -4)")
                                       (array (shape 0 1 1 3 -2 0) -1 -2 -3 -4)))

(test "srfi-25 eg.reader.4" #t (equal? (read-from-string "#,(<array> (0 2 0 3) #void #void #void #void #void #void)")
                                       (make-array (shape 0 2 0 3))))
(test "srfi-25 eg.reader.5" #t (equal? (read-from-string "#,(<array> (1 2 1 2 1 2) 7)")
                                       (make-array (shape 1 2  1 2 1 2) 7)))

(test "srfi-25 eg.reader.6" #t (equal? (read-from-string "#,(<array> (0 2 1 2 1 2) 0.0 0.0)")
                                       (make-array (shape 0 2  1 2 1 2) 0.)))


(test "srfi-25 eg.class-of" <array> (class-of (make-array (shape 0 2  1 2 1 2) 0.)))


(let ((arr (array (shape 0 2 0 2) 'a 'b 'c 'd)))
  (array-retabulate! arr (shape 0 2 0 2) (lambda (x y) (+ 1 x y)))
  (test "srfi-25 jp.array-retabulate!"
        #,(<array> (0 2 0 2) 1 2 2 3)
        arr))

(let ((a (array (shape 0 2 0 2 0 2) -1 -2 -3 -4 -5 -6 -7 -8)))
  (test "srfi-25 jp.share-row.1"
        #,(<array> (0 2 0 2) -1 -2 -3 -4)
        (share-row a 0))

  (test "srfi-25 jp.share-row.2"
        #,(<array> (0 2 0 2) -5 -6 -7 -8)
        (share-row a 1))

  (test "srfi-25 jp.share-col.1"
        (share-column a 0)
        #,(<array> (0 2 0 2) -1 -2 -5 -6))

  (test "srfi-25 jp.share-col.2"
        (share-column a 1)
        #,(<array> (0 2 0 2) -3 -4 -7 -8)))

(let ((a (array (shape 0 2 0 2 ) -1 -2 -3 -4)))
  (test "srfi-25 jp.share-array/origin"
        #,(<array> (1 3 1 3) -1 -2 -3 -4)
        (share-array/origin  a 1 1)))


(let ((a (array (shape 0 2 0 3) 11 22 33 44 55 66))
      (b (array (shape 0 3 0 3) -11 -22 -33 -44 -55 -66 -77 -88 -99))
      (c (array (shape 0 1 0 3) 'a 'b 'c)))
  (test "srfi-25 jp.array-append"
        #,(<array> (0 6 0 3)
                   11  22  33
                   44  55  66
                   -11 -22 -33
                   -44 -55 -66
                   -77 -88 -99
                   a   b   c)
        (array-append 0 a b c)))

(let ((a (array (shape 0 4 0 4)
                -1  -2   -3  -4
                -5  -6   -7  -8
                -9  -10 -11 -12
                -13 -14 -15 -16)))
  (test "srfi-25 jp.transpose.1"
        #,(<array> (0 4 0 4)
                   -1 -5  -9 -13
                   -2 -6 -10 -14
                   -3 -7 -11 -15
                   -4 -8 -12 -16)
        (transpose a)))


(let ((a (array (shape 0 3 0 3 0 2)
                -1 -2
                -3 -4
                -5 -6

                -7 -8
                -9 -10
                -11 -12

                -13 -14
                -15 -16
                -17 -18)))
  (test "srfi-25 jp.transpose.2"
        #,(<array> (0 2 0 3 0 3)
                   -1  -7 -13
                   -3  -9 -15
                   -5 -11 -17

                   -2  -8 -14
                   -4 -10 -16
                   -6 -12 -18)
        (transpose a)))

(let ((a (array (shape 0 4 0 4)
                -1 -2 -3 -4
                -5 -6 -7 -8
                -9 -10 -11 -12
                -13 -14 -15 -16)))
  (test "srfi-25 jp.share-nths.1"
        #,(<array> (0 2 0 4)
                   -1  -2  -3  -4
                   -9 -10 -11 -12)
        (share-nths a 0 2))
  (test  "srfi-25 jp.share-nths.2"
         #,(<array> (0 4 0 2)
                    -1  -3  -5  -7
                    -9 -11 -13 -15)
         (share-nths a 1 2)))



(let ((arr (array (shape 0 2 0 3 0 2)
                  -1 -2 -3 -4 -5 -6
                  -7 -8 -9 -10 -11 -12)))
  (test/error "srfi-25 jp.wrong-shape.1"
              (share-array arr (shape 0 12) (lambda (x) (values x x x))))
  (test/error "srfi-25 jp.wrong-shape.2"
              (share-array arr (shape 0 3) (lambda (x) (values (- x) x x))))
  (test/error "srfi-25 jp.wrong-shape.3"
              (share-array arr (shape 0 2 0 3 0 2) (lambda (x y) (- x 1) y)))
  (test/error "srfi-25 jp.wrong-shape.4"
              (share-array arr (shape 0 2 0 3 0 2) (lambda (x y) (+ x 1) y))))

(let ((a (array (shape 0 2 0 2) 'a 'b 'c 'd))
      (b (array (shape 0 4) 'a 'b 'c 'd)))
  (test "srfi-25 jp.unequal-shapes"
        #f
        (equal? a b)))

(let* ((a (array (shape 0 8) -1 -2 -3 -4 -5 -6 -7 -8))
       (b (array (shape 0 4) -1 -3 -5 -7))
       (c (share-array a
                       (shape 0 4)
                       (lambda (i) (* 2 i)))))
  (test "srfi-25 jp.array-equal?.1" #t (equal? b c)))

(let* ((a (array (shape 0 8) '(a b) -2 -3 -4 -5 -6 -7 -8))
       (b (array (shape 0 4) (list 'a 'b) -3 -5 -7))
       (c (share-array a (shape 0 4) (lambda (x) (* x 2)))))
  (test "srfi-25 jp.equal?.2" #t (equal? b c)))

(test "srfi-25 jp.array-setter"
      #,(<array> (0 4) (a b) -3 50 -7)
      (let ((a (array (shape 0 4) (list 'a 'b) -3 -5 -7)))
        (set! (array-ref a 2) 50)
        a))
