(load-relative "loadtest.ss")

(Section 'vector)

(require scheme/vector)


(test #t vector? '#(0 (2 2 2 2) "Anna"))
(test #t vector? '#())
(arity-test vector? 1 1)
(test '#(a b c) vector 'a 'b 'c)
(test '#() vector)
(test 3 vector-length '#(0 (2 2 2 2) "Anna"))
(test 0 vector-length '#())
(arity-test vector-length 1 1)
(err/rt-test (vector-length "apple"))
(test 8 vector-ref '#(1 1 2 3 5 8 13 21) 5)
(arity-test vector-ref 2 2)
(err/rt-test (vector-ref "apple" 3))
(err/rt-test (vector-ref #(4 5 6) 3) exn:application:mismatch?)
(err/rt-test (vector-ref #() 0) exn:application:mismatch?)
(err/rt-test (vector-ref #() (expt 2 100)) exn:application:mismatch?)
(err/rt-test (vector-ref #(4 5 6) -1))
(err/rt-test (vector-ref #(4 5 6) 2.0))
(err/rt-test (vector-ref #(4 5 6) "2"))
(test '#(0 ("Sue" "Sue") "Anna") 'vector-set
	(let ((vec (vector 0 '(2 2 2 2) "Anna")))
	  (vector-set! vec 1 '("Sue" "Sue"))
	  vec))
(test '#(hi hi) make-vector 2 'hi)
(test '#() make-vector 0)
(test '#() make-vector 0 'a)
(test 2048 vector-length (make-vector 2048 'a))
(arity-test make-vector 1 2)
(err/rt-test (make-vector "a" 'a))
(err/rt-test (make-vector 1.0 'a))
(err/rt-test (make-vector 10.2 'a))
(err/rt-test (make-vector -1 'a))
(err/rt-test (make-vector 1000000000000000000000 'a) exn:fail:out-of-memory?)
(arity-test vector-set! 3 3)
(err/rt-test (vector-set! #() 0 'x) exn:application:mismatch?)
(err/rt-test (vector-set! #(1 2 3) -1 'x))
(err/rt-test (vector-set! #(1 2 3) 3 'x) exn:application:mismatch?)
(err/rt-test (vector-set! #(1 2 3) (expt 2 100) 'x) exn:application:mismatch?)
(err/rt-test (vector-set! '(1 2 3) 2 'x))
(err/rt-test (vector-set! #(1 2 3) "2" 'x))
(define v (vector 1 2 3))
(vector-fill! v 0)
(test (quote #(0 0 0)) 'vector-fill! v)
(arity-test vector-fill! 2 2)
(err/rt-test (vector-fill! '(1 2 3) 0))



;; ---------- vector-take/drop[-right] ----------
(let ()
  (define-syntax-rule (vals-list expr)
    (call-with-values (lambda () expr) list))
  (define (split-at*       l n) (vals-list (vector-split-at       l n)))
  (define (split-at-right* l n) (vals-list (vector-split-at-right l n)))
  (define funs (list vector-take vector-drop vector-take-right vector-drop-right
                     split-at* split-at-right*))
  (define tests
    ;; -----args------ --take--- --drop--- --take-r--- --drop-r-
    '([(#(a b c d) 2)   #(a b)     #(c d)     #(c d)       #(a b)    ]
      [(#(a b c d) 0)   #()        #(a b c d) #()          #(a b c d)]
      [(#(a b c d) 4)   #(a b c d) #()        #(a b c d)   #()       ]))
  (for ([t tests]
        #:when #t
        [expect `(,@(cdr t)
                  ,(list (list-ref t 1) (list-ref t 2))
                  ,(list (list-ref t 4) (list-ref t 3)))]
        [fun funs])
    (apply test expect fun (car t)))
  (for ([fun funs])
    (arity-test fun 2 2)
    (err/rt-test (fun #(1 2 3) 2.0))
    (err/rt-test (fun #(1) '(1)))
    (err/rt-test (fun #(1) -1))
    (err/rt-test (fun #(1) 2) exn:application:mismatch?)))

;; ---------- vector-append ----------
(let ()
  (test #() vector-append #())
  (test #() vector-append #() #())
  (test #(1 2) vector-append #(1 2) #())
  (test #(1 2) vector-append #() #(1 2))
  (test #(a b) vector-append #(a) #(b))
  (test #(a b c) vector-append #(a b) #() #(c))
  (test #(a b d c) vector-append #(a b) #(d) #(c)))


;; ---------- vector-filter[-not] ----------
(let ()
  (define f vector-filter)
  (define fn vector-filter-not)

  (test #()              f  number? #())
  (test #()              fn number? #())
  (test #(1 2 3)         f  number? #(1 a 2 b 3 c d))
  (test #(a b c d)       fn number? #(1 a 2 b 3 c d))
  (test #()              f  string? #(1 a 2 b 3 c d))
  (test #(1 a 2 b 3 c d) fn string? #(1 a 2 b 3 c d))
  (err/rt-test (f  2 #(1 2 3)))
  (err/rt-test (fn 2 #(1 2 3)))
  (err/rt-test (f cons #(1 2 3)))
  (err/rt-test (fn cons #(1 2 3)))
  (arity-test f  2 2)
  (arity-test fn 2 2))


;; ---------- vector-count ----------

(let ()
  (test 0 vector-count even? #())
  (test 4 vector-count even? #(0 2 4 6))
  (test 0 vector-count even? #(1 3 5 7))
  (test 2 vector-count even? #(1 2 3 4))
  (test 2 vector-count < #(1 2 3 4) #(4 3 2 1)))

;; ---------- vector-copy ----------

(let ()
  (test #() vector-copy #())
  (test #(1 2 3) vector-copy #(1 2 3))
  (test #f immutable? (vector-copy #(1 2 3)))
  (let ([v (vector 1 2 3)])
    (test #f eq? v (vector-copy v))))



;; ---------- vector-arg{min,max} ----------

(let ()

  (define ((check-regs . regexps) exn)
    (and (exn:fail? exn)
         (andmap (λ (reg) (regexp-match reg (exn-message exn)))
                 regexps)))

  (test 'vector-argmin object-name vector-argmin)
  (test 1 vector-argmin (lambda (x) 0) (vector 1))
  (test 1 vector-argmin (lambda (x) x) (vector 1 2 3))
  (test 1 vector-argmin (lambda (x) 1) (vector 1 2 3))

  (test 3
        'vector-argmin-makes-right-number-of-calls
        (let ([c 0])
          (vector-argmin (lambda (x) (set! c (+ c 1)) 0)
			 (vector 1 2 3))
          c))

  (test '(1 banana) vector-argmin car #((3 pears) (1 banana) (2 apples)))

  (err/rt-test (vector-argmin 1 (vector 1)) (check-regs #rx"vector-argmin" #rx"procedure"))
  (err/rt-test (vector-argmin (lambda (x) x) 3) (check-regs #rx"vector-argmin" #rx"vector"))
  (err/rt-test (vector-argmin (lambda (x) x) (vector 1 #f)) (check-regs #rx"vector-argmin" #rx"procedure that returns real numbers"))
  (err/rt-test (vector-argmin (lambda (x) x) (vector #f)) (check-regs #rx"vector-argmin" #rx"procedure that returns real numbers"))

  (err/rt-test (vector-argmin (lambda (x) x) (vector +i)) (check-regs #rx"vector-argmin" #rx"procedure that returns real numbers"))
  (err/rt-test (vector-argmin (lambda (x) x) (vector)) (check-regs #rx"vector-argmin" #rx"non-empty vector"))

  (test 'vector-argmax object-name vector-argmax)
  (test 1 vector-argmax (lambda (x) 0) (vector 1))
  (test 3 vector-argmax (lambda (x) x) (vector 1 2 3))
  (test 1 vector-argmax (lambda (x) 1) (vector 1 2 3))

  (test 3
        'vector-argmax-makes-right-number-of-calls
        (let ([c 0])
          (vector-argmax (lambda (x) (set! c (+ c 1)) 0)
                  (vector 1 2 3))
          c))

  (test '(3 pears) vector-argmax car #((3 pears) (1 banana) (2 apples)))

  (err/rt-test (vector-argmax 1 (vector 1)) (check-regs #rx"vector-argmax" #rx"procedure"))
  (err/rt-test (vector-argmax (lambda (x) x) 3) (check-regs #rx"vector-argmax" #rx"vector"))
  (err/rt-test (vector-argmax (lambda (x) x) (vector 1 #f)) (check-regs #rx"vector-argmax" #rx"procedure that returns real numbers"))
  (err/rt-test (vector-argmax (lambda (x) x) (vector #f)) (check-regs #rx"vector-argmax" #rx"procedure that returns real numbers"))

  (err/rt-test (vector-argmax (lambda (x) x) (vector +i)) (check-regs #rx"vector-argmax" #rx"procedure that returns real numbers"))
  (err/rt-test (vector-argmax (lambda (x) x) (vector)) (check-regs #rx"vector-argmax" #rx"non-empty vector")))



;; ---------- check no collisions with srfi/43 ----------
#;(test (void)
      eval '(module foo scheme/base (require scheme/base srfi/43))
           (make-base-namespace))

(report-errs)