source: project/release/4/couchdb/tests/run.scm @ 16098

Last change on this file since 16098 was 16092, checked in by Moritz Heidkamp, 11 years ago

Initial commit of the couchdb client library

  • Property svn:executable set to *
File size: 2.3 KB
Line 
1(load-relative "../couchdb.scm")
2
3(use test http-client intarweb uri-common)
4
5(import couchdb)
6
7(define (simple-request method uri)
8  (condition-case (with-input-from-request
9                   (make-request method: method
10                                 uri: uri) values values)
11                  (exn (client-error) #f)))
12
13(server (uri-reference "http://localhost:5984/"))
14(database "chicken-test-couchdb")
15
16;; (Re)create the test database
17(let ([uri (update-uri (server) path: `(/ ,(database)))])
18  (simple-request 'DELETE uri)
19  (simple-request 'PUT uri))
20
21
22(test-group "server API"
23            (test-assert "reporting version" (json-ref 'version (get-server-info))))
24
25(test-group "database API"
26            (test-assert "creating" 
27                         (begin
28                           (simple-request 'DELETE (update-uri (server) path: '(/ "chicken-test-couchdb-foo")))
29                           (create-database "chicken-test-couchdb-foo")))
30
31            (test-assert "deleting"
32                         (begin
33                           (simple-request 'PUT (update-uri (server) path: '(/ "chicken-test-couchdb-foo")))
34                           (delete-database "chicken-test-couchdb-foo")))
35
36            (test "getting information about it" "chicken-test-couchdb" 
37                  (json-ref 'db_name (get-database-info))))
38
39
40(test-group "document API"
41
42  (let ([body (alist->hash-table '((foo . "bar")))])
43
44   (test "accessing attributes" "bar"
45         (document-attribute (make-document body: body) 'foo))
46
47   (test-assert "creating"
48                (document-id (save-document (make-document body: body))))
49
50   (test "creating with given id" "foo"
51         (document-id (save-document (make-document id: "foo"))))
52
53
54   (test "retrieving" "bar"
55         (let ([id (document-id (save-document (make-document body: body)))])
56           (document-attribute (get-document id) 'foo)))
57
58   (test-assert "deleting"
59                (let* ([doc (save-document (make-document))])
60                  (delete-document doc)
61                  (not (get-document (document-id doc)))))
62
63   (test "updating" "baz!"
64         (let* ([doc (save-document (make-document body: body))]
65                [doc (save-document (update-document doc body: (alist->hash-table '((foo . "baz!")))))])
66           (document-attribute (get-document (document-id doc)) 'foo))))
67
68  (test-group "errors"
69    (parameterize ([last-error #f])
70      (test-assert "retrieving non-existant document"
71                   (and (not (get-document "bogus"))
72                        (last-error))))
73
74    (parameterize ([last-error #f])
75      (test-assert "deleting non-existant document"
76                   (and (not (delete-document "something"))
77                        (last-error))))))
Note: See TracBrowser for help on using the repository browser.