(import scheme (chicken base) srfi-63  test)

(test-group
 "srfi-63"
 
 (test-assert
  "equal? with symbols"
  (equal? 'a 'a))

 (test-assert
  "equal? with lists"
  (equal? '(a)
          '(a)))

 (test-assert
  "equal? with sublists"
  (equal? '(a (b) c) '(a (b) c)))

 (test-assert
  "equal? with strings"
  (equal? "abc" "abc"))

 (test-assert
  "equal? with numbers"
  (equal? 2 2))

 (test-assert
  "equal? with vectors"
  (equal? (make-vector 5 'a) (make-vector 5 'a)))

 (test-assert
  "equal? with arrays fixnum arrays"
  (equal? (make-array (A:fixN32b 4) 5 3)
          (make-array (A:fixN32b 4) 5 3)))
 (test-assert
  "equal? with vector arrays"
  (equal? (make-array '#(foo) 3 3)
          (make-array '#(foo) 3 3)))

 (test
  "equal? with lambda"
  #f
  (equal? (lambda (x) x)
          (lambda (y) y)))

 (test
  "array-dimensions"
  '(3 5)
  (array-dimensions (make-array '#() 3 5)))

 (test-group
  "make-shared-array"
  (define fred (make-array '#(#f) 8 8))

  (define freds-diagonal
    (make-shared-array
     fred
     (lambda (i) (list i i)) 8))

  (array-set! freds-diagonal 'foo 3)

  (test
   "array-ref diagonal"
   'foo
   (array-ref fred 3 3))

  (define freds-center
    (make-shared-array fred
                       (lambda (i j)
                         (list (+ 3 i)
                               (+ 3 j))) 2 2))

  (test
   "array-ref center"
   'foo
   (array-ref freds-center 0 0)))

 (test
  "list->array two-dimensional"
  (vector->array '#(1 2 3 4) '#() 2 2)
  (list->array 2 '#() '((1 2) (3 4))))

 (test
  "list->array zero-dimensional"
  3
  (array->list (list->array 0 '#() 3)))

 ;; should really port srfi-58 to make use of the read notation
 (test
  "array->list"
  '((ho ho ho) (ho ho ho))
  (array->list (make-array '#(ho ho ho) 2 3)))

 (test
  "array-list zero-dimensional"
  'ho
  (array->list (list->array 0 '#() 'ho)))
 
 (test
  "vector->array"
  (list->array 2 '#() '((1 2) (3 4)))
  (vector->array '#(1 2 3 4) '#() 2 2))

 (test
  "array->vector"
  '#(1 2 3 4)
  (array->vector (vector->array '#(1 2 3 4) '#() 2 2))))

(test-exit)