(import (srfi 160 @))

(test-group "@vector tests"
  (define (times2 x) (* x 2))
  (define s5 (@vector 1 2 3 4 5))
  (define s4 (@vector 1 2 3 4))
  (define s5+ (@vector 1 2 3 4 6))

  (define (steady i x) (values x x))
  (define (count-up i x) (values x (+ x 1)))
  (define (count-down i x) (values x (- x 1)))
  (define (odd+1 x) (if (odd? x) (+ 1 x) #f))
  (define @vector< (comparator-ordering-predicate @vector-comparator))
  (define @vector-hash (comparator-hash-function @vector-comparator))

  (define g (make-@vector-generator s5))
  (define-syntax test-equiv
    (syntax-rules ()
      ((test-equiv expect expr)
       (test expect (map inexact->exact (@vector->list expr))))
      ((test-equiv name expect expr)
       (test name expect (map inexact->exact (@vector->list expr))))))

  (test-group "@vector"
    (test-group "@vector/constructors"
      (test-equiv "make" '(3 3 3 3 3) (make-@vector 5 3))
      (test-equiv "@vector" '(2 1 0 1 2) (@vector 2 1 0 1 2))
      (test-equiv "unfold up" '(10 11 12 13 14)
                  (@vector-unfold count-up 5 10))
      (test-equiv "unfold down" '(10 9 8 7 6)
                  (@vector-unfold count-down 5 10))
      (test-equiv "unfold steady" '(10 10 10 10 10)
                  (@vector-unfold steady 5 10))
      (test-equiv "unfold-right up" '(14 13 12 11 10)
                  (@vector-unfold-right count-up 5 10))
      (test-equiv "unfold-right down" '(6 7 8 9 10)
                  (@vector-unfold-right count-down 5 10))
      (test-equiv "unfold-right steady" '(10 10 10 10 10)
                  (@vector-unfold-right steady 5 10))
      (test-equiv "copy" '(1 2 3 4 5) (@vector-copy s5))
      (test-assert "copy2" (not (eqv? s5 (@vector-copy s5))))
      (test-equiv "copy3" '(2 3) (@vector-copy s5 1 3))
      (test-equiv "reverse-copy" '(5 4 3 2 1) (@vector-reverse-copy s5))
      (test-equiv "append" '(1 2 3 4 5 1 2 3 4 5)
                  (@vector-append s5 s5))
      (test-equiv "concatenate" '(1 2 3 4 5 1 2 3 4 5)
                  (@vector-concatenate (list s5 s5)))
      (test-equiv "append-subvectors" '(2 3 2 3)
                  (@vector-append-subvectors s5 1 3 s5 1 3))
      ) ; end @vector/constructors

    ;; (test-group "@vector/predicates"
    ;;   (test-assert "@?" (@? 5))
    ;;   (test-assert "not @?" (not (@? 65536)))
    ;;   (test-assert "@vector?" (@vector? s5))
    ;;   (test-assert "not @vector?" (not (@vector? #t)))
    ;;   (test-assert "empty" (@vector-empty? (@vector)))
    ;;   (test-assert "not empty" (not (@vector-empty? s5)))
    ;;   (test-assert "=" (@vector= (@vector 1 2 3) (@vector 1 2 3)))
    ;;   (test-assert "= multi" (@vector= (@vector 1 2 3)
    ;;                                    (@vector 1 2 3)
    ;;                                    (@vector 1 2 3)))
    ;;   (test-assert "not =" (not (@vector= (@vector 1 2 3) (@vector 3 2 1))))
    ;;   (test-assert "not =2" (not (@vector= (@vector 1 2 3) (@vector 1 2))))
    ;;   (test-assert "not = multi" (not (@vector= (@vector 1 2 3)
    ;;                                             (@vector 1 2 3)
    ;;                                             (@vector 3 2 1))))
    ;;   )
                                        ; end @vector/predicates

    (test-group "@vector/selectors"
      (test "ref" 1 (inexact->exact (@vector-ref (@vector 1 2 3) 0)))
      (test "length" 3 (@vector-length (@vector 1 2 3)))
      ) ; end @vector/selectors

    (test-group "@vector/iteration"
      (test-equiv "take" '(1 2) (@vector-take s5 2))
      (test-equiv "take-right" '(4 5) (@vector-take-right s5 2))
      (test-equiv "drop" '(3 4 5) (@vector-drop s5 2))
      (test-equiv "drop-right" '(1 2 3) (@vector-drop-right s5 2))
      (test "segment" (list (@vector 1 2 3) (@vector 4 5))
            (@vector-segment s5 3))
      (test "fold" -6 (inexact->exact (@vector-fold - 0 (@vector 1 2 3))))
      ;; (test "fold" '(((0 1 4) 2 5) 3 6)
      ;;       (@vector-fold list 0 (@vector 1 2 3) (@vector 4 5 6)))
      (test "fold-right" -6 (inexact->exact (@vector-fold-right - 0 (@vector 1 2 3))))
      ;; (test "fold-right" '(((0 3 6) 2 5) 1 4)
      ;;       (@vector-fold-right list 0 (@vector 1 2 3) (@vector 4 5 6)))
      (test-equiv "map" '(1 4 9 16 25) (@vector-map (cut expt <> 2) s5))
      (test-equiv "map" '(0 0 0 0 0) (@vector-map - s5 s5))
      (let ((v (@vector 1 2 3 4 5)))
        (@vector-map! (cut expt <> 2) v)
        (test-equiv "map!" '(1 4 9 16 25) v))
      (let ((v (@vector 1 2 3 4 5))
            (v2 (@vector 6 7 8 9 10)))
        (@vector-map! + v v2)
        (test-equiv "map!" '(7 9 11 13 15) v))
      (let ((list '()))
        (@vector-for-each
         (lambda (e) (set! list (cons e list)))
         s5)
        ;; stupid hack to shut up test egg about testing the value of a variable
        (test "for-each" '(5 4 3 2 1) (map inexact->exact (cons (car list) (cdr list)))))
      ;; (let ((list '()))
      ;;   (@vector-for-each
      ;;    (lambda (e1 e2) (set! list (cons (cons e1 e2) list)))
      ;;    s5
      ;;    (@vector 6 7 8 9 10))
      ;;   ;; stupid hack to shut up test egg about testing the value of a variable
      ;;   (test "for-each" '((5 . 10) (4 . 9) (3 . 8) (2 . 7) (1 . 6))
      ;;         (cons (car list) (cdr list))))
      (test "count" 3 (@vector-count odd? s5))
      (test "count" 2 (@vector-count > s5 (@vector 9 2 1 5 3)))
      (test-equiv "cumulate" '(1 3 6 10 15)
                  (@vector-cumulate + 0 s5))
      ) ; end @vector/iteration

    (test-group "@vector/searching"
      (test-equiv "take-while" '(1) (@vector-take-while odd? s5))
      (test-equiv "take-while-right" '(5) (@vector-take-while-right odd? s5))
      (test-equiv "drop-while" '(2 3 4 5) (@vector-drop-while odd? s5))
      (test-equiv "drop-while-right" '(1 2 3 4) (@vector-drop-while-right odd? s5))
      ;; (test-equiv "degenerate take-while" '() (@vector-take-while inexact? s5))
      ;; (test-equiv "degenerate take-while-right" '() (@vector-take-while-right inexact? s5))
      ;; (test-equiv "degenerate drop-while" '(1 2 3 4 5) (@vector-drop-while inexact? s5))
      ;; (test-equiv "degenerate drop-while-right" '(1 2 3 4 5) (@vector-drop-while-right inexact? s5))
      (test "index" 1 (@vector-index even? s5))
      (test "index" 2 (@vector-index < s5 (@vector 0 0 10 10 0)))
      (test "index-right" 3 (@vector-index-right even? s5))
      (test "index-right" 3 (@vector-index-right < s5 (@vector 0 0 10 10 0)))
      (test "skip" 1 (@vector-skip odd? s5))
      (test "skip" 2 (@vector-skip > s5 (@vector 0 0 10 10 0)))
      (test "skip-right" 3 (@vector-skip-right odd? s5))
      (test "skip-right" 3 (@vector-skip-right > s5 (@vector 0 0 10 10 0)))
      (test "any" 4 (inexact->exact (@vector-any (lambda (x) (and (even? x) (* x 2))) s5)))
      (test-assert "not any" (not (@vector-any list? s5)))
      (test "any + 1" 2 (inexact->exact (@vector-any odd+1 s5)))
      (test-assert "every" (@vector-every number? s5))
      (test-assert "not every" (not (@vector-every odd? s5)))
      (test-assert "every + 1" (not (@vector-every odd+1 s5)))
      (test "multi-any" 10 (inexact->exact (@vector-any (lambda (x y) (and (even? x) (even? y) (+ x y)))
                                                        s5 (@vector 0 1 2 6 4))))
      (test "multi-any 2" #f (@vector-any (lambda (x y) (and (even? x) (even? y) (+ x y)))
                                          s5 (@vector 0 1 2 5 4)))
      (test "multi-every" 10 (inexact->exact (@vector-every (lambda (x) (and (number? x) (* x 2))) s5)))
      (test "multi-every-2" 10 (inexact->exact (@vector-every (lambda (x y) (and (number? x) (number? y) (+ x y)))
                                                              s5 s5)))
      (test-assert "multi-not every" (not (@vector-every < s5 (@vector 10 10 10 10 0))))
      (test-equiv "partition" '(1 3 5 2 4) (@vector-partition odd? s5))
      (test-equiv "filter" '(1 3 5) (@vector-filter odd? s5))
      (test-equiv "remove" '(2 4) (@vector-remove odd? s5))
      ) ; end @vector/searching

    (test-group "@vector/mutators"
      (let ((v (@vector 1 2 3)))
        ;; (display "set!\n")
        (@vector-set! v 0 10)
        (test-equiv "set!" '(10 2 3) v))
      (let ((v (@vector 1 2 3)))
        ;; (display "swap!\n")
        (@vector-swap! v 0 1)
        (test-equiv "swap!" '(2 1 3) v))
      (let ((v (@vector 1 2 3)))
        ;; (display "fill!\n")
        (@vector-fill! v 2)
        (test-equiv "fill!" '(2 2 2) v))
      (let ((v (@vector 1 2 3)))
        ;; (display "fill2!\n")
        (@vector-fill! v 10 0 2)
        (test-equiv "fill2!" '(10 10 3) v))
      (let ((v (@vector 1 2 3)))
        ;; (display "reverse!\n")
        (@vector-reverse! v)
        (test-equiv "reverse!" '(3 2 1) v))
      (let ((v (@vector 1 2 3)))
        ;; (display "reverse!\n")
        (@vector-reverse! v 1 3)
        (test-equiv "reverse2!" '(1 3 2) v))
      (let ((v (@vector 10 20 30 40 50)))
        ;; (display "copy!\n")
        (@vector-copy! v 1 s5 2 4)
        (test-equiv "copy!" '(10 3 4 40 50) v))
      (let ((v (@vector 10 20 30 40 50)))
        ;; (display "reverse-copy!\n")
        (@vector-reverse-copy! v 1 s5 2 4)
        (test-equiv "reverse-copy!" '(10 4 3 40 50) v))
      (let ((v (@vector 1 2 3 4 5 6 7 8)))
        ;; (display "unfold!")
        (@vector-unfold! (lambda (x) (values (* x 2) (* x 2)))
                         v 1 6 1)
        (test-equiv "vector-unfold!" '(1 2 4 8 16 32 7 8) v))
      (let ((v (@vector 1 2 3 4 5 6 7 8)))
        ;; (display "unfold-right!")
        (@vector-unfold-right! (lambda (x) (values (* x 2) (* x 2)))
                               v 1 6 1)
        (test-equiv "vector-unfold!" '(1 32 16 8 4 2 7 8) v))
      ) ; end @vector/mutators

    (test-group "@vector/conversion"
      (test "@vector->list 1" '(1 2 3 4 5)
            (map inexact->exact (@vector->list s5)))
      (test "@vector->list 2" '(2 3 4 5)
            (map inexact->exact (@vector->list s5 1)))
      (test "@vector->list 3" '(2 3 4)
            (map inexact->exact (@vector->list s5 1 4)))
      (test "@vector->vector 1" #(1 2 3 4 5)
            (vector-map inexact->exact (@vector->vector s5)))
      (test "@vector->vector 2" #(2 3 4 5)
            (vector-map inexact->exact (@vector->vector s5 1)))
      (test "@vector->vector 3" #(2 3 4)
            (vector-map inexact->exact (@vector->vector s5 1 4)))
      (test-equiv "list->@vector" '(1 2 3 4 5)
                  (list->@vector '(1 2 3 4 5)))
      (test-equiv "reverse-list->@vector" '(5 4 3 2 1)
                  (reverse-list->@vector '(1 2 3 4 5)))
      (test-equiv "vector->@vector 1" '(1 2 3 4 5)
                  (vector->@vector #(1 2 3 4 5)))
      (test-equiv "vector->@vector 2" '(2 3 4 5)
                  (vector->@vector #(1 2 3 4 5) 1))
      (test-equiv "vector->@vector 3" '(2 3 4)
                  (vector->@vector #(1 2 3 4 5) 1 4))
      ) ; end @vector/conversion

    (test-group "@vector/misc"
      ;; (let ((port (open-output-string)))
      ;;   (write-@vector s5 port)
      ;;   (test "write-@vector" "#@(1 2 3 4 5)" (get-output-string port))
      ;;   (close-output-port port))

      (test-assert "@vector< short" (@vector< s4 s5))
      (test-assert "not @vector< short" (not (@vector< s5 s4)))
      (test-assert "@vector< samelen" (@vector< s5 s5+))
      (test-assert "not @vector< samelen" (not (@vector< s5+ s5+)))
      (test-assert "@vector=" (@vector= s5+ s5+))
      (test "@vector-hash" 15 (@vector-hash s5))

      (test "@vector-gen 0" 1 (inexact->exact (g)))
      (test "@vector-gen 1" 2 (inexact->exact (g)))
      (test "@vector-gen 2" 3 (inexact->exact (g)))
      (test "@vector-gen 3" 4 (inexact->exact (g)))
      (test "@vector-gen 4" 5 (inexact->exact (g)))
      (test-assert (eof-object? (g)))
      ) ; end @vector/misc

    ) ; end @vector

  )