(import (scheme base)
        (scheme char)
        (gauche base)
        (record-vector)
        )

(define rv record-vector)

(define string->keyword make-keyword)

(define-syntax test-group
  (syntax-rules ()
    ((_ name t1 ...)
     (begin
       (define nt 0)
       (define passed 0)
       (print "\n--- Test group '" name "' ---\n")
       (for-each (lambda (r)
                   (set! nt (+ 1 nt))
                   (when r (set! passed (+ 1 passed))))
                 (list t1 ...))
       (print "--- End group '" name "', " nt " tests " passed " passed ---\n\n")))))

(define-syntax test
  (syntax-rules ()
    ((_ name tval what)
     (let ()
       (print "Test " name " ... ")
       (cond ((equal? tval what) (print "[PASS]\n") #t)
             (else (print "[FAIL]\n") #f))))
    ((_ tval what)
     (let ()
       (print "Test (?) ...")
       (cond ((equal? tval what) (print "[PASS]\n") #t)
             (else (print "[FAIL]\n") #f))))))

(define-syntax test-error
  (syntax-rules ()
    ((_ name what)
     (let ((r
            (call/cc (lambda (k)
                       (with-exception-handler
                        (lambda (e) (k #t))
                        (lambda () what #f))))))
       (print "Test " name " for error ... " (if r "[PASS]" "[FAIL]") "\n")))))

(define-syntax test-exit
  (syntax-rules ()
    ((_) (exit 0))))

(test-group "Create"
  (test "first" '(((:first . 0)) . #(1)) (record-vector :first 1))

  (test "x y z" '(((:x . 0) (:y . 1) (:z . 2)) . #(0.0 1.0 -1.0))
        (record-vector-clone
         (record-vector :x 11.0 :y -1e1)
         :x 0.0 :y 1.0 :z -1.0))

  (test "by hand"
        "KYZ"
        (rv-ref '(((:k . 1) (:an . 0) (:property-hoperty . 2)) . #(1 'a "KYZ")) :property-hoperty))

  (test "Errr"
        #f
        (rv-ref '(((:key . 0)) . #(199)) :keyc))

  (test "Err-rv"
        #f
        (rv-ref (record-vector :key 1) :Key))

  (test-error "Wrong kw order" (record-vector :k :w 100 200))

  (test-error "Wrong key type" (recoid-vector 'k 19 'w 20))

  (test "big" 1000
        (let loop ((r (rv)) (i 1))
          (cond ((= i 1001) (rv-ref r :k1000))
                (else (rv-update! r (string->keyword
                                     (string-append
                                      "k"
                                      (number->string i)))
                                  i)
                      (loop r (+ 1 i))))))

  (test "Cycloid" 10
        (let ((r (record-vector :r #f :value 10)))
          (rv-set! r :r r)
          (rv-ref r :r :r :r :r :r :r :r :r :r :value)))

  (test "Casesences"
        #t
        (let ((r (make-rv :x #t :X #t :_x #t)))
          (and (rv-ref r :x)
               (rv-ref r :X)
               (rv-ref r :_x))))
  )



(test-group "Clone"
  (test `(((:x . 0)) . #(100)) (rv-clone (rv :x 1) :x 100))

  (test "clone  with sub records" #t
        (let* ((et (rv :ab 1 :cd 0 :ef (rv :x 1.0 :y 1.0)))
               (cet (rv-clone et :cd -1)))
          (rv-set! cet :ef :y 111.0)
          (and (= (rv-ref et :ab) (rv-ref cet :ab))
               (not (= (rv-ref et :cd) (rv-ref cet :cd)))
               (= (rv-ref et :ef :y) 1.0)
               (= (rv-ref cet :ef :y) 111.0))))
  (test "Clone inplace" 'test (rv-ref (rv-clone `(((:test . 0)) . #(xtest)) :test 'test) :test))

  (test "Clone step by step"
        '(((:phone . 0) (:address . 1) (:name . 2)) . #("1-900-LOVE" "Nowhere st." "Lexx"))
        (let* ((h (rv))
               (h-p (rv-clone h :phone "1-900-LOVE"))
               (h-a (rv-clone h-p :address "Nowhere st."))
               (h-n (rv-clone h-a :name "Lexx")))
          h-n))
  )

(test-group "Get/Set/Update"
  (test "Full reset" (/ 2000.0 1000.0)
        (let ((r (rv :tag 'rec :sub "A" :posn (rv :x 0.0 :y 0.0))))
          (do ((i 0 (+ 1 i)))
              ((= i 1000) (/ (rv-ref r :posn :y)
                             (rv-ref r :posn :x)))
            (rv-set! r :posn :x (+ 1 (rv-ref r :posn :x)))
            (rv-set! r :posn :y (+ 2 (rv-ref r :posn :y))))))

  (test "Get unknown attribute" #f
        (rv-ref (rv :x 10000000) :X))

  (test "Get default value" 1001
        (record-vector-ref '(() . #()) :x 1001))

  (test-error "Fail set err attribute"
              (rv-set! '(() . #()) :x 'notok))

  (test "Plan to update" '(10 . "L")
        (let ((r (rv)))
          (for-each (lambda (kw) (rv-update! r kw (keyword->string kw)))
                    '(:a :b :c :d :e :F :I :J :K :L))
          (cons (rv-len r) (rv-ref r :L))))

  (test "Iterate over values" "RECORD"
        (apply string
               (vector->list
                (vector-map
                 char-upcase
                 (cdr (rv :x1 #\r
                          :x2 #\e
                          :x3 #\c
                          :x4 #\o
                          :x5 #\r
                          :x6 #\d))))))

  (test "Access by index" 43
        (let ((r (rv :val 1
                     :level-1 (rv :val 2
                                  :level-2 (rv :val 43)))))
          (rv-ref r 1 1 0)))
  )

(test-group "Equality & duck typing"
  (test "Empty record-vector? 1" #t (record-vector? '(() . #())))
  (test "Empty record-vector? 2" #t (record-vector? (rv)))

  (test "Both empty's equals" #t  (rv-like? '(() . #()) (rv)))

  (test "One of empty" #f (or (rv-like? '(() . #()) (rv :x 100))
                              (rv-like? (rv :x 200) '(() . #()))))

  (test "Equal clones" #t (let* ((et (rv :z 1 :t 0.001))
                                 (rc (rv-clone et)))
                            (equal? et rc)))
  (test "Like a" #t (let* ((et (rv :z 1 :t 0.001))
                           (rc (rv-clone et :z 2 :t 1.001 :h 300)))
                      (rv-like? et rc)))
  )



(test-exit)