#lang scheme/base
(require "test-base.ss")
(require scheme/dict
(unlib-in hash)
"snooze-api.ss"
"test-data.ss"
"snooze-cache-test-util.ss"
"era/era.ss")
(define snooze-concurrency-tests
(test-suite "snooze-concurrency-tests"
#:before
(lambda ()
(recreate-test-tables))
#:after
drop-all-tables
(test-suite "eq?, equal?, guid=?"
(test-case "create"
(cache-clear!)
(check-cache-size (list 0))
(let ([person1 (make-person "Dave")]
[person2 (make-person "Dave")])
(check-cache-size (list 2))
(check-not-eq? person1 person2)
(check-false (guid=? person1 person2))
(check-equal? person1 person2)
(check-equal? (person-name person1) "Dave")
(check-equal? (person-name person2) "Dave")))
(test-case "load"
(recreate-test-tables)
(save! (make-person "Dave"))
(cache-clear!)
(check-cache-size (list 0))
(let ([person1 (select-one #:from person)]
[person2 (select-one #:from person)])
(check-cache-size (list 1))
(check-not-eq? person1 person2)
(check-true (guid=? person1 person2))
(check-equal? person1 person2)
(check-equal? (person-name person1) "Dave")
(check-equal? (person-name person2) "Dave")))
(test-case "create, copy"
(cache-clear!)
(check-cache-size (list 0))
(let ([person1 (make-person "Dave")]
[person2 (person-set (make-person "Dave"))])
(check-cache-size (list 3))
(check-not-eq? person1 person2)
(check-false (guid=? person1 person2))
(check-equal? person1 person2)
(check-equal? (person-name person1) "Dave")
(check-equal? (person-name person2) "Dave")))
(test-case "load, copy"
(recreate-test-tables)
(save! (make-person "Dave"))
(cache-clear!)
(check-cache-size (list 0))
(let ([person1 (select-one #:from person)]
[person2 (person-set (select-one #:from person))])
(check-cache-size (list 2))
(check-not-eq? person1 person2)
(check-false (guid=? person1 person2))
(check-equal? person1 person2)
(check-equal? (person-name person1) "Dave")
(check-equal? (person-name person2) "Dave")))
(test-case "create, modify"
(cache-clear!)
(check-cache-size (list 0))
(let* ([person1 (make-person "Dave")]
[person2 (person-set person1 #:name "David")])
(check-cache-size (list 2))
(check-not-eq? person1 person2)
(check-false (guid=? person1 person2))
(check-not-equal? person1 person2)
(check-equal? (person-name person1) "Dave")
(check-equal? (person-name person2) "David")))
(test-case "load, modify"
(recreate-test-tables)
(save! (make-person "Dave"))
(cache-clear!)
(check-cache-size (list 0))
(let* ([person1 (select-one #:from person)]
[person2 (person-set person1 #:name "David")])
(check-cache-size (list 2))
(check-not-eq? person1 person2)
(check-false (guid=? person1 person2))
(check-not-equal? person1 person2)
(check-equal? (person-name person1) "Dave")
(check-equal? (person-name person2) "David")))
(test-case "create, modify, save"
(cache-clear!)
(check-cache-size (list 0))
(let* ([person1 (make-person "Dave")]
[person2 (person-set person1 #:name "David")]
[person3 (save! person2)])
(check-cache-size (list 2))
(check-not-eq? person1 person3)
(check-false (guid=? person1 person3))
(check-not-equal? person1 person3)
(check-eq? person2 person3)
(check-true (guid=? person2 person3))
(check-equal? person2 person3)
(check-equal? (person-name person1) "Dave")
(check-equal? (person-name person2) "David")
(check-equal? (person-name person3) "David")))
(test-case "load, modify, save"
(recreate-test-tables)
(save! (make-person "Dave"))
(cache-clear!)
(check-cache-size (list 0))
(let* ([person1 (select-one #:from person)]
[person2 (person-set person1 #:name "David")]
[person3 (save! person2)])
(check-equal? (equal-hash-code person1)
(equal-hash-code person3))
(check-equal? (equal-hash-code person2)
(equal-hash-code person3))
(check-cache-size (list 1))
(check-not-eq? person1 person3)
(check-true (guid=? person1 person3))
(check-equal? person1 person3)
(check-eq? person2 person3)
(check-true (guid=? person2 person3))
(check-equal? person2 person3)
(check-equal? (person-name person1) "David")
(check-equal? (person-name person2) "David")
(check-equal? (person-name person3) "David"))))
(test-suite "modifying structs"
(test-case "load, modify"
(recreate-test-tables)
(cache-clear!)
(check-cache-size (list 0))
(save! (make-person "Dave"))
(check-cache-size (list 1))
(cache-clear!)
(check-cache-size (list 0))
(let* ([person1 (select-one #:from person)]
[person2 (person-set person1 #:name "David")])
(check-cache-size (list 2))
(check-not-eq? person1
person2)
(check-not-equal? person1
person2)
(check-equal? (guid-id person1)
(guid-id person2))
(check-not-equal? (guid-serial person1)
(guid-serial person2))
(check-equal? (person-name person1) "Dave")
(check-equal? (person-name person2) "David")))
(test-case "load, modify, reload"
(recreate-test-tables)
(cache-clear!)
(check-cache-size (list 0))
(save! (make-person "Dave"))
(check-cache-size (list 1))
(cache-clear!)
(check-cache-size (list 0))
(debug-location)
(let*/debug ([person1 (person-set (select-one #:from person))]
[person2a (select-one #:from person)]
[person2b (person-set person2a #:name "David")]
[person2 (save! person2b)])
(check-cache-size (list 2))
(debug-location)
(let ([person3 (select-one #:from person)])
(debug-location)
(check-cache-size (list 2))
(check-equal? (person-name person1) "Dave")
(check-equal? (person-name person2a) "David")
(check-equal? (person-name person2b) "David")
(check-equal? (person-name person2) "David")
(check-equal? (person-name person3) "David"))))
(test-case "load, modify, save"
(recreate-test-tables)
(cache-clear!)
(check-cache-size (list 0))
(save! (make-person "Dave"))
(check-cache-size (list 2))
(cache-clear!)
(check-cache-size (list 0))
(let* ([person1 (select-one #:from person)]
[person2 (save! (person-set person1 #:name "David"))])
(check-cache-size (list 2))
(check-equal? (person-name person1) "David")
(check-equal? (person-name person2) "David"))))
(test-suite "pushing and popping frames"
(test-case "create, push cache"
(cache-clear!)
(check-cache-size (list 0))
(let ([person1 (make-person "Dave")])
(check-equal? (person-name person1) "Dave")
(check-cache-size (list 1))
(with-cache
(check-cache-size (list 0 1))
(check-equal? (person-name person1) "Dave")
(check-cache-size (list 1 1)))))
(test-case "push cache, create"
(cache-clear!)
(check-cache-size (list 0))
(let ([person1 #f])
(with-cache
(check-cache-size (list 0 0))
(set! person1 (make-person "Dave"))
(check-cache-size (list 1 0))
(check-equal? (person-name person1) "Dave"))
(check-cache-size (list 0))
(check-exn exn:fail:snooze:cache? (cut person-name person1))))
(test-case "push cache, create, save"
(cache-clear!)
(check-cache-size (list 0))
(let ([person1 #f]
[person2 #f])
(with-cache
(check-cache-size (list 0 0))
(set! person1 (make-person "Dave"))
(check-cache-size (list 1 0))
(set! person2 (save! person1))
(check-cache-size (list 2 1))
(check-equal? (guid-id person1) (guid-id person2))
(check-equal? (person-name person1) "Dave")
(check-equal? (person-name person2) "Dave"))
(check-cache-size (list 1))
(pretty-print (cache-alist))
(check-exn exn:fail:snooze:cache? (cut person-name person1))
(check-not-exn (cut person-name person2))))
(test-case "push frame, load"
(cache-clear!)
(check-cache-size (list 0))
(let ([guid1 #f]
[struct1 #f])
(with-cache
(check-cache-size (list 0 0))
(set! guid1 (select-one #:from person))
(set! struct1 (send (current-snooze) cache-ref guid1))
(check-cache-size (list 1 1))
(check-equal? (person-name guid1) "Dave"))
(check-cache-size (list 1))
(check-not-eq? (send (current-snooze) cache-ref guid1) struct1))))
(test-case "inter-struct reference: make, clear, load, traverse ref"
(cache-clear!)
(check-cache-size (list 0))
(let* ([person1 (make-person "Jon")]
[person1-id (guid-id person1)]
[pet1 (make-pet person1 "Garfield")]
[pet1-id (guid-id pet1)])
(check-cache-size (list 2))
(debug "a" (cache-alist))
(let ([person2 (save! person1)]
[pet2 (save! pet1)])
(debug "b" (cache-alist))
(cache-clear!)
(check-cache-size (list 0))
(let ([pet3 (select-one #:from pet)])
(debug "c" (cache-alist))
(check-cache-size (list 1))
(check-equal? (person-name (pet-owner pet3)) "Jon")
(debug "d" (cache-alist))
(check-cache-size (list 2))))))
))
(provide snooze-concurrency-tests)