(import (scheme base)
        (gambit)
        (record-vector)
        )

(define rv record-vector)

(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 ()
    ((_) (void))))

(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)