source: project/release/4/nomads/trunk/tests/run.scm @ 21538

Last change on this file since 21538 was 21538, checked in by certainty, 9 years ago

nomads: it now complains if a migration to a non-existent version is requested

File size: 6.1 KB
Line 
1;;
2;; Author: David Krentzlin
3;;
4;; Created: Do Nov 11 16:25:19 2010 (CET)
5;; Last-Updated: Do Nov 18 19:36:32 2010 (CET)
6;;           By:
7
8
9(use test sql-de-lite)
10
11(use nomads nomads-sql-de-lite)
12
13
14
15;;utilities
16(db-schema-version-table "schema-info")
17
18;;configure the environment
19(define test-db "/tmp/migrations-test.db")
20(migration-directory "./migrations/without-irreversible")
21(database-credentials test-db)
22(debug #f)
23
24(define (wipe-table table-name)
25  ((db-with-connection) test-db (lambda (db)
26                             (exec (sql db (sprintf "DROP TABLE IF EXISTS \"~A\"" table-name))))))
27
28(define (fetch-versions)
29  (flatten ((db-with-connection) test-db (lambda (db)
30                                         (query fetch-all (sql db "SELECT version FROM tests"))))))
31
32(define (reset-db)
33  ((db-with-connection) test-db (lambda (db)
34                                (exec (sql db "DELETE FROM tests"))
35                                (exec (sql db (sprintf  "DELETE FROM \"~A\"" (db-schema-version-table)))))))
36
37(define (initialize-test-db)
38  ((db-with-connection) test-db  (lambda (db)
39                                   (exec (sql db  "CREATE TABLE IF NOT EXISTS tests (version INTEGER)")))))
40
41
42(define (latest-version)
43  ((db-with-connection) test-db (lambda (db)
44                                (db-latest-version db))))
45
46(define (test-migration to #!key (reset #f))
47  (initialize-test-db)
48  (if reset (reset-db))
49  (migrate version: to callback: (lambda args #t))
50  (latest-version)
51  (cons (latest-version) (fetch-versions)))
52
53
54
55;;basic tests
56(test-group "Utils"
57            (test "extract version from file"
58                  '(1 . "test-migration")
59                  ((filename-partitioner) "01-test-migration"))
60
61            (test "extract version from file without version"
62                  '( #f . "file-without-version")
63                  ((filename-partitioner) "file-without-version")))
64
65
66(test-group "Database-Binding"
67
68            (test "connect"
69                  #t
70                  (handle-exceptions exn #f ((db-with-connection) test-db (lambda (con) #t))))
71
72            (test "create version table"
73                  (db-schema-version-table)
74                  (begin
75                    (wipe-table (db-schema-version-table))
76                    ((db-with-connection) test-db (lambda (con)
77                                                    ((db-initialize-schema-information) con (db-schema-version-table))
78                                                    (first-column
79                                                     (query fetch (sql con "SELECT name FROM sqlite_master WHERE name=?") (db-schema-version-table)))))))
80
81
82            (test "first-migration? detects first run"
83                  #t
84                  (begin
85                    (wipe-table (db-schema-version-table))
86                    ((db-with-connection) test-db (lambda (db)
87                                                    (not ((db-schema-information-exists?) db (db-schema-version-table)))))))
88
89            (test "first-migration? detects existing migrations"
90                  #t
91                  ((db-with-connection) test-db (lambda (db)
92                                                  ((db-initialize-schema-information) db (db-schema-version-table))
93                                                  ((db-schema-information-exists?) db (db-schema-version-table))))))
94
95
96(test-group "System"
97            (test "migrates from earliest to latest"
98                  `(3  1 2 3)
99                  (test-migration 'latest reset: #t))
100
101            (test "migrates from latest to earliest"
102                  `(#f)
103                  (begin
104                    (test-migration 'latest reset: #t)
105                    (test-migration 'earliest)))
106
107            (test "migrates from earliest to specific"
108                  '(2 1 2)
109                  (test-migration 2 reset: #t))
110
111            (test "migrates from specific to earliest"
112                  '(#f)
113                  (begin
114                    (test-migration 2 reset: #t)
115                    (test-migration 'earliest)))
116
117            (test "migrates from specific to latest"
118                  '(3 1 2 3)
119                  (begin
120                    (test-migration 1 reset: #t)
121                    (test-migration 'latest)))
122
123            (test "migrates from latest to specific"
124                  '(1 1)
125                  (begin
126                    (test-migration 'latest reset: #t)
127                    (test-migration 1)))
128
129            (test "doesn't migrate if up to date"
130                  '(1 1)
131                  (begin
132                    (test-migration 1 reset: #t)
133                    (test-migration 1)))
134
135            (test "doesn't migrate from earliest to earliest"
136                  '(#f)
137                  (begin
138                    (test-migration 'earliest reset: #t)
139                    (test-migration 'earliest)))
140
141            (test "doesn't migrate from latest to latest"
142                  '(3 1 2 3)
143                  (begin
144                    (test-migration 'latest reset: #t)
145                    (test-migration 'latest)))
146
147
148            (test "irreversable migrations"
149                  '(4 1 2 3 4)
150                  (parameterize ((migration-directory "./migrations/with-irreversible"))
151                    (test-migration 'latest reset: #t)
152                    (test-migration 'earliest)))
153
154
155            (test "detect dublicate migrations"
156                  'duplicate-migrations
157                  (parameterize ((migration-directory "./migrations/with-duplicates")
158                                 (error-on-duplicate-migrations #t))
159                      (condition-case  (test-migration 'latest reset: #t)
160                        ((nomads-error duplicate-version) 'duplicate-migrations))))
161
162            (test "detect non-existent versions"
163                  'non-existent-version
164                  (parameterize ((error-on-non-existent-version #t))
165                    (condition-case (test-migration 100 reset: #t)
166                      ((nomads-error non-existent-version) 'non-existent-version))))
167
168
169            )
170
171;; (test "detect duplicate migrations-versions" #t #f)
172
173(unless (zero? (test-failure-count)) (exit 1))
174
Note: See TracBrowser for help on using the repository browser.