(sc-include-once
  sph-dg-test-helper "test/helper")

; these values should not be below 3, or important cases would not be tested.
; the values should also not be so high that the linearly created ordinals exceed the size of the ordinal type.
; tip: reduce for debugging
(define common-element-count b32 40)
(define common-label-count b32 40)

(pre-define (test-relation-read-records-validate-one name)
  ;test that the result records contain all filter-ids, and the filter-ids contain all result record values for field "name".
  (set records-temp records)
  (while records-temp
    (if
      (not
        (dg-ids-contains?
          (pre-concat existing_ name) (struct-get (dg-relation-records-first records-temp) name)))
      (begin
        (printf "\n  result records contain inexistant %s ids\n" (pre-stringify name))
        (dg-debug-display-relation-records records)
        (status-set-id-goto 1)))
    (set records-temp (dg-relation-records-rest records-temp)))
  (set ids-temp (pre-concat existing_ name))
  (while ids-temp
    (if
      (not
        ( (pre-concat dg-debug-relation-records-contains-at_ name _p)
          records (dg-ids-first ids-temp)))
      (begin
        (printf "\n  %s result records do not contain all existing-ids\n" (pre-stringify name))
        (dg-debug-display-relation-records records)
        (status-set-id-goto 2)))
    (set ids-temp (dg-ids-rest ids-temp))))

(define
  (test-relation-read-records-validate
    records left existing-left right existing-right label existing-label ordinal)
  (status-t
    dg-relation-records-t*
    dg-ids-t* dg-ids-t* dg-ids-t* dg-ids-t* dg-ids-t* dg-ids-t* dg-ordinal-match-data-t*)
  status-init
  (define
    records-temp dg-relation-records-t*
    ids-temp dg-ids-t*)
  (test-relation-read-records-validate-one left)
  (test-relation-read-records-validate-one right)
  (test-relation-read-records-validate-one label)
  (label exit
    (return status)))

(pre-define test-relation-read-header
  (begin
    status-init
    (define state dg-relation-read-state-t)
    (define ordinal-min b32 2)
    (define ordinal-max b32 5)
    (define ordinal-match-data dg-ordinal-match-data-t (struct-literal ordinal-min ordinal-max))
    (define ordinal dg-ordinal-match-data-t* (address-of ordinal-match-data))
    (define records dg-relation-records-t* 0)
    (define existing-left-count b32 common-label-count)
    (define existing-right-count b32 common-element-count)
    (define existing-label-count b32 common-label-count)
    (define
      expected-count b32
      reader-suffix b8
      reader-suffix-string b8*)
    (dg-define-ids-3 existing-left existing-right existing-label)
    (dg-define-ids-3 left right label)
    (status-require!
      (test-helper-create-relations
        existing-left-count
        existing-right-count
        existing-label-count
        (address-of existing-left) (address-of existing-right) (address-of existing-label)))
    ;add additional ids that do not exist in any relation
    (status-require! (test-helper-ids-add-new-ids existing-left (address-of left)))
    (status-require! (test-helper-ids-add-new-ids existing-right (address-of right)))
    (status-require! (test-helper-ids-add-new-ids existing-label (address-of label)))
    dg-txn-introduce
    dg-txn-begin
    (printf " ")))

(pre-define (test-relation-read-one left right label ordinal offset)
  (set reader-suffix (test-helper-filter-ids->reader-suffix-integer left right label ordinal))
  (set reader-suffix-string (test-helper-reader-suffix-integer->string reader-suffix))
  (printf " %s" reader-suffix-string)
  (free reader-suffix-string)
  (set records 0)
  (status-require! (dg-relation-select dg-txn left right label ordinal offset (address-of state)))
  (dg-status-require-read! (dg-relation-read (address-of state) 2 (address-of records)))
  (dg-status-require-read! (dg-relation-read (address-of state) 0 (address-of records)))
  (if (status-id-is? dg-status-id-no-more-data)
    (status-set-id status-id-success)
    (begin
      (printf "\n  final read result does not indicate that there is no more data")
      (status-set-id-goto 1)))
  (set expected-count
    (test-helper-estimate-relation-read-result-count
      existing-left-count existing-right-count existing-label-count ordinal))
  (if (not (= (dg-relation-records-length records) expected-count))
    (begin
      (printf
        "\n  expected %lu read %lu. ordinal min %d max %d\n"
        expected-count
        (dg-relation-records-length records) (if* ordinal ordinal-min 0) (if* ordinal ordinal-max 0))
      (printf "the read ")
      (dg-debug-display-relation-records records)
      (dg-debug-display-all-relations dg-txn)
      (status-set-id-goto 1)))
  (if (not ordinal)
    (status-require!
      (test-relation-read-records-validate
        records left existing-left right existing-right label existing-label ordinal)))
  dg-status-success-if-no-more-data
  (dg-relation-selection-destroy (address-of state))
  (dg-relation-records-destroy records))

(pre-define test-relation-delete-header
  (begin
    status-init
    (define state dg-relation-read-state-t)
    (define records dg-relation-records-t* 0)
    (dg-define-ids-3 left right label)
    (define ordinal-match-data dg-ordinal-match-data-t (struct-literal 2 5))
    (define ordinal dg-ordinal-match-data-t* (address-of ordinal-match-data))
    (define read-count-before-expected b32)
    (define btree-count-after-delete b32)
    (define existing-left-count b32 common-label-count)
    (define btree-count-before-delete b32)
    (define btree-count-deleted-expected b32)
    (define btree-count-after-expected b32)
    (define existing-right-count b32 common-element-count)
    (define existing-label-count b32 common-label-count)
    dg-txn-introduce
    (printf " ")))

(pre-define (test-relation-delete-one left? right? label? ordinal?)
  ; for any given argument permutation:
  ; * checks btree entry count difference
  ; * checks read result count after deletion, using the same search query
  (printf " %d%d%d%d" left? right? label? ordinal?)
  dg-txn-begin
  (dg-debug-count-all-btree-entries dg-txn (address-of btree-count-before-delete))
  dg-txn-abort
  ; add non-relation elements
  (status-require!
    (test-helper-create-relations
      common-label-count
      common-element-count common-label-count (address-of left) (address-of right) (address-of label)))
  dg-txn-write-begin
  (status-require!
    (dg-relation-delete
      dg-txn (if* left? left 0) (if* right? right 0) (if* label? label 0) (if* ordinal? ordinal 0)))
  (dg-debug-count-all-btree-entries dg-txn (address-of btree-count-after-delete))
  (dg-status-require-read!
    (dg-relation-select
      dg-txn
      (if* left? left 0)
      (if* right? right 0) (if* label? label 0) (if* ordinal? ordinal 0) 0 (address-of state)))
  ;checks that readers can handle selections with no elements
  (dg-status-require-read! (dg-relation-read (address-of state) 0 (address-of records)))
  (dg-relation-selection-destroy (address-of state))
  dg-txn-commit
  (set read-count-before-expected
    (test-helper-estimate-relation-read-result-count
      existing-left-count existing-right-count existing-label-count ordinal))
  ;relations are assumed to have linearly incremented ordinals starting with 1
  (if (not (= 0 (dg-relation-records-length records)))
    (begin
      (printf
        "\n    failed deletion. %lu relations not deleted\n" (dg-relation-records-length records))
      (dg-debug-display-relation-records records)
      dg-txn-begin
      ;(dg-debug-display-all-relations dg-txn)
      dg-txn-abort
      (status-set-id-goto 1)))
  (dg-relation-records-destroy records)
  (set records 0)
  (set btree-count-before-delete
    (+ btree-count-before-delete existing-left-count existing-right-count existing-label-count))
  (set btree-count-deleted-expected
    (test-helper-estimate-relation-read-btree-entry-count
      existing-left-count existing-right-count existing-label-count ordinal))
  (set btree-count-after-expected (- btree-count-after-delete btree-count-deleted-expected))
  (if
    (not
      (and
        (= btree-count-after-expected btree-count-after-delete)
        (if* ordinal? #t (= btree-count-after-delete btree-count-before-delete))))
    (begin
      (printf
        "\n    failed deletion. %lu btree entries remaining, expected %lu\n"
        btree-count-after-delete btree-count-after-expected)
      dg-txn-begin
      (dg-debug-display-btree-counts dg-txn)
      (dg-status-require-read! (dg-relation-select dg-txn 0 0 0 0 0 (address-of state)))
      (dg-status-require-read! (dg-relation-read (address-of state) 0 (address-of records)))
      (printf "all remaining ")
      (dg-debug-display-relation-records records)
      (dg-relation-selection-destroy (address-of state))
      dg-txn-abort
      (status-set-id-goto 1)))
  (dg-ids-destroy left)
  (dg-ids-destroy right)
  (dg-ids-destroy label)
  (set
    records 0
    left 0
    right 0
    label 0))

(define (test-id-create-identify-exists) status-t
  status-init
  (define ids-result dg-ids-t* 0)
  dg-txn-introduce
  dg-txn-write-begin
  (status-require! (dg-id-create dg-txn 3 (address-of ids-result)))
  (if (not (and ids-result (= 3 (dg-ids-length ids-result)))) (status-set-id-goto 1))
  (define boolean-result boolean)
  (status-require! (dg-exists? dg-txn ids-result (address-of boolean-result)))
  (test-helper-assert "dg-exists?" boolean-result)
  (define ids dg-ids-t* ids-result)
  (set ids-result 0)
  (status-require! (dg-identify dg-txn ids (address-of ids-result)))
  (test-helper-assert "result length" (and ids-result (= 3 (dg-ids-length ids-result))))
  (label exit
    (if dg-txn dg-txn-abort)
    (dg-ids-destroy ids)
    (dg-ids-destroy ids-result)
    (return status)))

(define (test-statistics) status-t
  status-init
  dg-txn-introduce
  dg-txn-begin
  (define stat dg-statistics-t)
  (status-require! (dg-statistics dg-txn (address-of stat)))
  (label exit
    (if dg-txn dg-txn-abort)
    (return status)))

(define (test-extern) status-t
  (define data-ids dg-ids-t* 0)
  status-init
  dg-txn-introduce
  dg-txn-write-begin
  (define data-element-value dg-id-t 2)
  (define data-element dg-data-t
    (struct-literal (size dg-size-octets-id) (data (address-of data-element-value))))
  (status-require! (dg-extern-create dg-txn 50 (address-of data-element) (address-of data-ids)))
  (test-helper-assert "dg-extern? 1" (and data-ids (dg-extern? (dg-ids-first data-ids))))
  (define data-list dg-data-list-t* 0)
  (status-require! (dg-extern-id->data dg-txn data-ids #t (address-of data-list)))
  (test-helper-assert
    "data-equal?"
    (equal?
      (deref (convert-type data-element.data dg-id-t*))
      (deref (convert-type (struct-get (dg-data-list-first data-list) data) dg-id-t*))))
  (define data-ids-2 dg-ids-t* 0)
  (dg-status-require-read! (dg-extern-data->id dg-txn data-element (address-of data-ids-2)))
  (test-helper-assert "dg-extern? 2" (dg-extern? (dg-ids-first data-ids)))
  (test-helper-assert "dg-extern? 3 " (dg-extern? (dg-ids-first data-ids-2)))
  dg-txn-commit
  (label exit
    (if dg-txn dg-txn-abort)
    (return status)))

(define (test-intern) status-t
  ; todo: should test more than one data element
  (define data-ids dg-ids-t* 0)
  (define data-element-value dg-id-t 2)
  (define data-element dg-data-t
    (struct-literal (size dg-size-octets-id) (data (address-of data-element-value))))
  (define data dg-data-list-t* (dg-data-list-add 0 data-element))
  status-init
  dg-txn-introduce
  dg-txn-write-begin
  (status-require! (dg-intern-ensure dg-txn data (address-of data-ids)))
  (test-helper-assert
    "dg-intern-ensure result length" (= (dg-ids-length data-ids) (dg-data-list-length data)))
  (define id-first dg-id-t (dg-ids-first data-ids))
  (test-helper-assert "dg-intern?" (and data-ids (dg-intern? id-first)))
  (define data-2 dg-data-list-t* 0)
  (define data-ids-2 dg-ids-t* 0)
  (status-require! (dg-intern-id->data dg-txn data-ids #t (address-of data-2)))
  (test-helper-assert
    "id->data return length" (and data (= (dg-ids-length data-ids) (dg-data-list-length data-2))))
  (status-require! (dg-intern-data->id dg-txn data #t (address-of data-ids-2)))
  dg-txn-commit
  (test-helper-assert
    "data->id return length" (and data (= (dg-ids-length data-ids-2) (dg-data-list-length data))))
  dg-txn-write-begin
  (set data-element-value 9)
  (status-require! (dg-intern-update dg-txn id-first data-element))
  (define status-2 status-t (struct-literal 0 0))
  (set status-2 (dg-intern-update dg-txn id-first data-element))
  (test-helper-assert "duplicate update prevention" (= dg-status-id-duplicate status-2.id))
  dg-txn-commit
  dg-txn-begin
  (define data-ids-3 dg-ids-t* (dg-ids-add 0 id-first))
  (define data-3 dg-data-list-t* 0)
  (status-require! (dg-intern-id->data dg-txn data-ids-3 #t (address-of data-3)))
  dg-txn-abort
  (label exit
    (if dg-txn dg-txn-abort)
    (dg-ids-destroy data-ids)
    (dg-ids-destroy data-ids-2)
    (dg-data-list-destroy data)
    (dg-data-list-destroy data-2)
    (return status)))

(define (test-index) status-t
  status-init
  (define ids dg-ids-t*)
  (dg-define-ids-3 left right label)
  (status-require!
    (test-helper-create-relations
      common-label-count
      common-element-count common-label-count (address-of left) (address-of right) (address-of label)))
  (status-require! (test-helper-create-interns common-element-count (address-of ids)))
  dg-txn-introduce
  (status-require! (dg-index-recreate-intern))
  (status-require! (dg-index-recreate-extern))
  ;(status-require! (dg-index-recreate-relation))
  (define index-errors-extern dg-index-errors-extern-t)
  (define index-errors-intern dg-index-errors-intern-t)
  (define index-errors-relation dg-index-errors-relation-t)
  dg-txn-begin
  (status-require! (dg-index-errors-intern dg-txn (address-of index-errors-intern)))
  (status-require! (dg-index-errors-extern dg-txn (address-of index-errors-extern)))
  (status-require! (dg-index-errors-relation dg-txn (address-of index-errors-relation)))
  (test-helper-assert "errors-intern?" (not (struct-get index-errors-intern errors?)))
  (test-helper-assert "errors-extern?" (not (struct-get index-errors-extern errors?)))
  (test-helper-assert "errors-relation?" (not (struct-get index-errors-relation errors?)))
  (label exit
    (if dg-txn dg-txn-abort)
    (return status)))

(define (test-relation) status-t
  status-init
  (dg-define-ids-3 right left label)
  (status-require!
    (test-helper-create-relations
      common-label-count
      common-element-count common-label-count (address-of left) (address-of right) (address-of label)))
  dg-txn-introduce
  dg-txn-write-begin
  (status-require! (dg-relation-ensure dg-txn left right label 0 0))
  dg-txn-commit
  (label exit
    (if dg-txn dg-txn-abort)
    (return status)))

(define (test-node-read) status-t
  status-init
  (define ids-intern dg-ids-t* 0)
  (define ids-id dg-ids-t* 0)
  (status-require! (test-helper-create-interns common-element-count (address-of ids-intern)))
  (status-require! (test-helper-create-ids common-element-count (address-of ids-id)))
  dg-txn-introduce
  dg-txn-begin
  (define state dg-node-read-state-t)
  (status-require! (dg-node-select dg-txn 0 0 (address-of state)))
  (define records dg-data-records-t* 0)
  (dg-status-require-read! (dg-node-read (address-of state) 0 (address-of records)))
  (dg-node-selection-destroy (address-of state))
  (test-helper-assert
    "result length" (= (dg-data-records-length records) (* 2 common-element-count)))
  (dg-data-records-destroy records)
  ; with type filter
  (set records 0)
  (status-require! (dg-node-select dg-txn 1 0 (address-of state)))
  (dg-status-require-read! (dg-node-read (address-of state) 0 (address-of records)))
  (dg-node-selection-destroy (address-of state))
  (test-helper-assert
    "result length with type filter" (= (dg-data-records-length records) common-element-count))
  (dg-data-records-destroy records)
  (label exit
    (if dg-txn dg-txn-abort)
    dg-status-success-if-no-more-data
    (return status)))

(pre-define test-relation-read-body
  (begin
    (test-relation-read-one left 0 0 0 0)
    (test-relation-read-one left 0 label 0 0)
    (test-relation-read-one left right 0 0 0)
    (test-relation-read-one left right label 0 0)
    (test-relation-read-one 0 0 0 0 0)
    (test-relation-read-one 0 0 label 0 0)
    (test-relation-read-one 0 right 0 0 0)
    (test-relation-read-one 0 right label 0 0)
    (test-relation-read-one left 0 0 ordinal 0)
    (test-relation-read-one left 0 label ordinal 0)
    (test-relation-read-one left right 0 ordinal 0)
    (test-relation-read-one left right label ordinal 0)
    dg-status-success-if-no-more-data))

(define (test-relation-read) status-t
  test-relation-read-header
  test-relation-read-body
  (label exit
    (printf "\n")
    (if dg-txn dg-txn-abort)
    (return status)))

(define (test-relation-delete) status-t
  ;the tests depend partly on the correctness of relation-read
  test-relation-delete-header
  (test-relation-delete-one 1 0 0 0)
  (test-relation-delete-one 1 0 1 0)
  (test-relation-delete-one 1 1 0 0)
  (test-relation-delete-one 1 1 1 0)
  (test-relation-delete-one 0 0 1 0)
  (test-relation-delete-one 0 1 0 0)
  (test-relation-delete-one 0 1 1 0)
  (test-relation-delete-one 1 0 0 1)
  (test-relation-delete-one 1 0 1 1)
  (test-relation-delete-one 1 1 0 1)
  (test-relation-delete-one 1 1 1 1)
  (label exit
    (printf "\n")
    (return status)))

(define (test-concurrent-write/read-thread status-pointer) (b0* b0*)
  status-init
  (set status (deref (convert-type status-pointer status-t*)))
  (define state dg-relation-read-state-t)
  (define records dg-relation-records-t* 0)
  dg-txn-introduce
  dg-txn-begin
  (set records 0)
  (status-require! (dg-relation-select dg-txn 0 0 0 0 0 (address-of state)))
  (dg-status-require-read! (dg-relation-read (address-of state) 2 (address-of records)))
  (dg-status-require-read! (dg-relation-read (address-of state) 0 (address-of records)))
  dg-txn-abort
  (label exit
    dg-status-success-if-no-more-data
    (set (deref (convert-type status-pointer status-t*)) status)))

(define (test-concurrent-write/read) status-t
  status-init
  (define
    thread-two pthread_t
    thread-three pthread_t)
  (status-require! (test-helper-dg-reset #f))
  (dg-define-ids-3 left right label)
  (status-require!
    (test-helper-create-relations
      common-element-count
      common-element-count common-label-count (address-of left) (address-of right) (address-of label)))
  (define thread-two-result status-t (struct-literal 0 0))
  (define thread-three-result status-t (struct-literal 0 0))
  (if
    (pthread-create
      (address-of thread-two) 0 test-concurrent-write/read-thread (address-of thread-two-result))
    (begin
      (printf "error creating thread")
      (status-set-id-goto 1)))
  (if
    (pthread-create
      (address-of thread-three) 0 test-concurrent-write/read-thread (address-of thread-three-result))
    (begin
      (printf "error creating thread")
      (status-set-id-goto 1)))
  (test-concurrent-write/read-thread (address-of status))
  status-require
  (if (pthread-join thread-two 0)
    (begin
      (printf "error joining thread")
      (status-set-id-goto 2)))
  (if (pthread-join thread-three 0)
    (begin
      (printf "error joining thread")
      (status-set-id-goto 2)))
  (set status thread-two-result)
  status-require
  (set status thread-three-result)
  (label exit
    (return status)))

(define (test-id-creation) status-t
  status-init
  dg-txn-introduce
  (define count b32 32)
  (define ids dg-ids-t* 0)
  (while count
    dg-txn-write-begin
    (dg-id-create dg-txn 2 (address-of ids))
    dg-txn-commit
    ; re-open the database so that the id initialisation is done again
    (test-helper-dg-reset #t)
    (set count (- count 1)))
  (define ids-a dg-ids-t* ids)
  (define ids-b dg-ids-t* 0)
  (define ids-c dg-ids-t* ids-b)
  ; check for duplicates
  (while ids-a
    (while ids-c
      (if (= (dg-ids-first ids-a) (dg-ids-first ids-c)) (status-set-id-goto 1))
      (set ids-c (dg-ids-rest ids-c)))
    (set ids-b (dg-ids-add ids-b (dg-ids-first ids-a)))
    (set ids-c ids-b)
    (set ids-a (dg-ids-rest ids-a)))
  (dg-ids-destroy ids)
  (label exit
    (return status)))

(define (main) int
  status-init
  (test-helper-test-one test-id-creation)
  (test-helper-test-one test-concurrent-write/read)
  (test-helper-test-one test-relation-read)
  (test-helper-test-one test-relation-delete)
  (test-helper-test-one test-statistics)
  (test-helper-test-one test-id-create-identify-exists)
  (test-helper-test-one test-intern)
  (test-helper-test-one test-extern)
  (test-helper-test-one test-node-read)
  (test-helper-test-one test-relation)
  (test-helper-test-one test-index)
  (label exit
    (if dg-initialised (dg-exit))
    (if status-success?
      (printf "--\ntests finished successfully.\n")
      (printf "\ntests failed. %d %s\n" (struct-get status id) (dg-status-description status)))
    (return (struct-get status id))))