3 # The author disclaims copyright to this source code. In place of
4 # a legal notice, here is a blessing:
6 # May you do good and not evil.
7 # May you find forgiveness for yourself and forgive others.
8 # May you share freely, never taking more than you give.
10 #***********************************************************************
11 # This file implements regression tests for SQLite library. The
12 # focus of this script is page cache subsystem.
14 # $Id: pager.test,v 1.23 2005/01/22 03:39:39 danielk1977 Exp $
17 set testdir [file dirname $argv0]
18 source $testdir/tester.tcl
20 if {[info commands pager_open]!=""} {
23 # Basic sanity check. Open and close a pager.
26 catch {file delete -force ptf1.db}
27 catch {file delete -force ptf1.db-journal}
29 set ::p1 [pager_open ptf1.db 10]
34 } {ref 0 page 0 max 10 size -1 state 0 err 0 hit 0 miss 0 ovfl 0}
40 } {ref 0 page 0 max 10 size -1 state 0 err 0 hit 0 miss 0 ovfl 0}
45 # Try to write a few pages.
49 set ::p1 [pager_open ptf1.db 10]
54 # set ::g1 [page_get $::p1 0]
59 set ::gx [page_lookup $::p1 1]
63 } {ref 0 page 0 max 10 size -1 state 0 err 0 hit 0 miss 0 ovfl 0}
66 set ::g1 [page_get $::p1 1]
68 if {$v} {lappend v $msg}
73 } {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
75 set ::gx [page_lookup $::p1 1]
80 } {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
87 } {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
90 } {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
96 } {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
108 } {ref 0 page 0 max 10 size -1 state 0 err 0 hit 0 miss 1 ovfl 0}
110 set ::g1 [page_get $::p1 1]
118 } {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 2 ovfl 0}
121 page_write $::g1 "Page-One"
127 } {ref 1 page 1 max 10 size 1 state 2 err 0 hit 0 miss 2 ovfl 0}
139 } {ref 1 page 1 max 10 size -1 state 1 err 0 hit 1 miss 2 ovfl 0}
141 pager_pagecount $::p1
145 } {ref 1 page 1 max 10 size 1 state 1 err 0 hit 1 miss 2 ovfl 0}
151 } {ref 0 page 0 max 10 size -1 state 0 err 0 hit 1 miss 2 ovfl 0}
156 if {$v} {lappend v $::g1}
164 page_write $::g1 {page-one}
179 set ::g1 [page_get $::p1 1]
188 set ::p1 [pager_open ptf1.db 15]
190 if {$v} {lappend v $msg}
194 pager_pagecount $::p1
198 set ::g(1) [page_get $::p1 1]
200 if {$v} {lappend v $msg}
207 for {set i 2} {$i<=20} {incr i} {
208 set gx [page_get $::p1 $i]
209 page_write $gx "Page-$i"
214 for {set i 2} {$i<=20} {incr i} {
215 do_test pager-3.6.[expr {$i-1}] [subst {
216 set gx \[page_get $::p1 $i\]
217 set v \[page_read \$gx\]
222 for {set i 1} {$i<=20} {incr i} {
224 set ::g1 [page_get $::p1 CNT]
225 set ::g2 [page_get $::p1 CNT]
226 set ::vx [page_read $::g2]
229 do_test pager-3.7.$i.1 $body {1}
232 set vy [page_read $::g1]
235 do_test pager-3.7.$i.2 $body {1}
238 set gx [page_get $::p1 CNT]
239 set vy [page_read $gx]
243 do_test pager-3.7.$i.3 $body {1}
249 # tests of the checkpoint mechanism and api
253 file delete -force ptf1.db
254 set ::p1 [pager_open ptf1.db 15]
256 if {$v} {lappend v $msg}
260 set g1 [page_get $::p1 1]
261 page_write $g1 "Page-1 v0"
262 for {set i 2} {$i<=20} {incr i} {
263 set gx [page_get $::p1 $i]
264 page_write $gx "Page-$i v0"
269 for {set i 1} {$i<=20} {incr i} {
270 do_test pager-4.2.$i {
271 set gx [page_get $p1 $i]
272 set v [page_read $gx]
278 lrange [pager_stats $::p1] 0 1
281 lrange [pager_stats $::p1] 8 9
284 for {set i 1} {$i<20} {incr i} {
285 do_test pager-4.5.$i.0 {
287 for {set j 2} {$j<=20} {incr j} {
288 set gx [page_get $p1 $j]
289 set value [page_read $gx]
291 set shouldbe "Page-$j v[expr {$i-1}]"
292 if {$value!=$shouldbe} {
293 lappend res $value $shouldbe
298 do_test pager-4.5.$i.1 {
299 page_write $g1 "Page-1 v$i"
300 lrange [pager_stats $p1] 8 9
302 do_test pager-4.5.$i.2 {
303 for {set j 2} {$j<=20} {incr j} {
304 set gx [page_get $p1 $j]
305 page_write $gx "Page-$j v$i"
312 do_test pager-4.5.$i.3 {
314 for {set j 2} {$j<=20} {incr j} {
315 set gx [page_get $p1 $j]
316 set value [page_read $gx]
318 set shouldbe "Page-$j v$i"
319 if {$value!=$shouldbe} {
320 lappend res $value $shouldbe
325 do_test pager-4.5.$i.4 {
328 for {set j 2} {$j<=20} {incr j} {
329 set gx [page_get $p1 $j]
330 set value [page_read $gx]
332 set shouldbe "Page-$j v[expr {$i-1}]"
333 if {$value!=$shouldbe} {
334 lappend res $value $shouldbe
339 do_test pager-4.5.$i.5 {
340 page_write $g1 "Page-1 v$i"
341 lrange [pager_stats $p1] 8 9
343 do_test pager-4.5.$i.6 {
344 for {set j 2} {$j<=20} {incr j} {
345 set gx [page_get $p1 $j]
346 page_write $gx "Page-$j v$i"
353 do_test pager-4.5.$i.7 {
354 pager_stmt_rollback $p1
355 for {set j 2} {$j<=20} {incr j} {
356 set gx [page_get $p1 $j]
357 set value [page_read $gx]
359 if {$j<=$i || $i==1} {
360 set shouldbe "Page-$j v$i"
362 set shouldbe "Page-$j v[expr {$i-1}]"
364 if {$value!=$shouldbe} {
365 lappend res $value $shouldbe
370 do_test pager-4.5.$i.8 {
371 for {set j 2} {$j<=20} {incr j} {
372 set gx [page_get $p1 $j]
373 page_write $gx "Page-$j v$i"
380 do_test pager-4.5.$i.9 {
381 pager_stmt_commit $p1
382 for {set j 2} {$j<=20} {incr j} {
383 set gx [page_get $p1 $j]
384 set value [page_read $gx]
386 set shouldbe "Page-$j v$i"
387 if {$value!=$shouldbe} {
388 lappend res $value $shouldbe
393 do_test pager-4.5.$i.10 {
395 lrange [pager_stats $p1] 8 9
399 # Test that nothing bad happens when sqlite3pager_set_cachesize() is
400 # called with a negative argument.
401 do_test pager-4.6.1 {
402 pager_close [pager_open ptf2.db -15]
405 # Test truncate on an in-memory database is Ok.
407 do_test pager-4.6.2 {
408 set ::p2 [pager_open :memory: 10]
409 pager_truncate $::p2 5
411 do_test pager-4.6.3 {
412 for {set i 1} {$i<5} {incr i} {
413 set p [page_get $::p2 $i]
414 page_write $p "Page $i"
418 pager_truncate $::p2 3
420 do_test pager-4.6.4 {
431 file delete -force ptf1.db
433 } ;# end if( not mem: and has pager_open command );
436 # Ticket #615: an assertion fault inside the pager. It is a benign
437 # fault, but we might as well test for it.
444 PRAGMA synchronous=off;
450 # The following tests cover rolling back hot journal files.
451 # They can't be run on windows because the windows version of
452 # SQLite holds a mandatory exclusive lock on journal files it has open.
454 if {$tcl_platform(platform)!="windows"} {
456 file delete -force test2.db
457 file delete -force test2.db-journal
460 PRAGMA synchronous = 0;
461 CREATE TABLE abc(a, b, c);
462 INSERT INTO abc VALUES(1, 2, randstr(200,200));
463 INSERT INTO abc VALUES(1, 2, randstr(200,200));
464 INSERT INTO abc VALUES(1, 2, randstr(200,200));
465 INSERT INTO abc VALUES(1, 2, randstr(200,200));
466 INSERT INTO abc VALUES(1, 2, randstr(200,200));
467 INSERT INTO abc VALUES(1, 2, randstr(200,200));
468 INSERT INTO abc VALUES(1, 2, randstr(200,200));
469 INSERT INTO abc VALUES(1, 2, randstr(200,200));
470 INSERT INTO abc VALUES(1, 2, randstr(200,200));
472 UPDATE abc SET c = randstr(200,200);
474 copy_file test2.db test.db
475 copy_file test2.db-journal test.db-journal
477 set f [open test.db-journal a]
478 fconfigure $f -encoding binary
479 seek $f [expr [file size test.db-journal] - 1032] start
480 puts -nonewline $f "\00\00\00\00"
485 SELECT sql FROM sqlite_master
487 } {{CREATE TABLE abc(a, b, c)}}
490 copy_file test2.db test.db
491 copy_file test2.db-journal test.db-journal
493 set f [open test.db-journal a]
494 fconfigure $f -encoding binary
495 seek $f [expr [file size test.db-journal] - 1032] start
496 puts -nonewline $f "\00\00\00\FF"
501 SELECT sql FROM sqlite_master
503 } {{CREATE TABLE abc(a, b, c)}}
506 copy_file test2.db test.db
507 copy_file test2.db-journal test.db-journal
509 set f [open test.db-journal a]
510 fconfigure $f -encoding binary
511 seek $f [expr [file size test.db-journal] - 4] start
512 puts -nonewline $f "\00\00\00\00"
517 SELECT sql FROM sqlite_master
519 } {{CREATE TABLE abc(a, b, c)}}