--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/persistentstorage/sqlite3api/TEST/TclScript/pager2.test	Fri Jan 22 11:06:30 2010 +0200
@@ -0,0 +1,411 @@
+# 2001 September 15
+#
+# The author disclaims copyright to this source code.  In place of
+# a legal notice, here is a blessing:
+#
+#    May you do good and not evil.
+#    May you find forgiveness for yourself and forgive others.
+#    May you share freely, never taking more than you give.
+#
+#***********************************************************************
+# This file implements regression tests for SQLite library.  The
+# focus of this script is page cache subsystem.
+#
+# $Id: pager2.test,v 1.7 2008/08/20 14:49:25 danielk1977 Exp $
+
+
+set testdir [file dirname $argv0]
+source $testdir/tester.tcl
+
+# Don't run this test file if the pager test interface [pager_open] is not
+# available, or the library was compiled without in-memory database support.
+#
+if {[info commands pager_open]!=""} {
+ifcapable memorydb {
+db close
+
+# Basic sanity check.  Open and close a pager.
+#
+do_test pager2-1.0 {
+  set v [catch {
+    set ::p1 [pager_open :memory: 10]
+  } msg]
+} {0}
+do_test pager2-1.1 {
+  pager_stats $::p1
+} {ref 0 page 0 max 10 size 0 state 0 err 0 hit 0 miss 0 ovfl 0}
+do_test pager2-1.2 {
+  pager_pagecount $::p1
+} {0}
+do_test pager2-1.3 {
+  pager_stats $::p1
+} {ref 0 page 0 max 10 size 0 state 0 err 0 hit 0 miss 0 ovfl 0}
+do_test pager2-1.4 {
+  pager_close $::p1
+} {}
+
+# Try to write a few pages.
+#
+do_test pager2-2.1 {
+  set v [catch {
+    set ::p1 [pager_open :memory: 10]
+  } msg]
+} {0}
+#do_test pager2-2.2 {
+#  set v [catch {
+#    set ::g1 [page_get $::p1 0]
+#  } msg]
+#  lappend v $msg
+#} {1 SQLITE_ERROR}
+do_test pager2-2.3.1 {
+  set ::gx [page_lookup $::p1 1]
+} {}
+do_test pager2-2.3.2 {
+  pager_stats $::p1
+} {ref 0 page 0 max 10 size 0 state 0 err 0 hit 0 miss 0 ovfl 0}
+do_test pager2-2.3.3 {
+  set v [catch {
+    set ::g1 [page_get $::p1 1]
+  } msg]
+  if {$v} {lappend v $msg}
+  set v
+} {0}
+do_test pager2-2.3.3 {
+  pager_stats $::p1
+} {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
+do_test pager2-2.3.4 {
+  set ::gx [page_lookup $::p1 1]
+  page_unref $::gx
+  expr {$::gx!=""}
+} {1}
+do_test pager2-2.3.5 {
+  pager_stats $::p1
+} {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
+do_test pager2-2.3.6 {
+  expr {$::g1==$::gx}
+} {1}
+do_test pager2-2.3.7 {
+  pager_stats $::p1
+} {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
+do_test pager2-2.4 {
+  pager_stats $::p1
+} {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
+do_test pager2-2.5 {
+  pager_pagecount $::p1
+} {0}
+do_test pager2-2.6 {
+  pager_stats $::p1
+} {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
+do_test pager2-2.7 {
+  page_number $::g1
+} {1}
+do_test pager2-2.8 {
+  page_read $::g1
+} {}
+do_test pager2-2.9 {
+  page_unref $::g1
+} {}
+do_test pager2-2.10 {
+  pager_stats $::p1
+} {ref 0 page 1 max 10 size 0 state 0 err 0 hit 0 miss 1 ovfl 0}
+do_test pager2-2.11 {
+  set ::g1 [page_get $::p1 1]
+  expr {$::g1!=0}
+} {1}
+do_test pager2-2.12 {
+  page_number $::g1
+} {1}
+do_test pager2-2.13 {
+  pager_stats $::p1
+} {ref 1 page 1 max 10 size 0 state 1 err 0 hit 1 miss 1 ovfl 0}
+do_test pager2-2.14 {
+  set v [catch {
+    page_write $::g1 "Page-One"
+  } msg]
+  lappend v $msg
+} {0 {}}
+do_test pager2-2.15 {
+  pager_stats $::p1
+} {ref 1 page 1 max 10 size 1 state 4 err 0 hit 1 miss 1 ovfl 0}
+do_test pager2-2.16 {
+  page_read $::g1
+} {Page-One}
+do_test pager2-2.17 {
+  set v [catch {
+    pager_commit $::p1
+  } msg]
+  lappend v $msg
+} {0 {}}
+do_test pager2-2.20 {
+  pager_stats $::p1
+} {ref 1 page 1 max 10 size 1 state 1 err 0 hit 1 miss 1 ovfl 0}
+do_test pager2-2.19 {
+  pager_pagecount $::p1
+} {1}
+do_test pager2-2.21 {
+  pager_stats $::p1
+} {ref 1 page 1 max 10 size 1 state 1 err 0 hit 1 miss 1 ovfl 0}
+do_test pager2-2.22 {
+  page_unref $::g1
+} {}
+do_test pager2-2.23 {
+  pager_stats $::p1
+} {ref 0 page 1 max 10 size 1 state 0 err 0 hit 1 miss 1 ovfl 0}
+do_test pager2-2.24 {
+  set v [catch {
+    page_get $::p1 1
+  } ::g1]
+  if {$v} {lappend v $::g1}
+  set v
+} {0}
+do_test pager2-2.25 {
+  page_read $::g1
+} {Page-One}
+do_test pager2-2.26 {
+  set v [catch {
+    page_write $::g1 {page-one}
+  } msg]
+  lappend v $msg
+} {0 {}}
+do_test pager2-2.27 {
+  page_read $::g1
+} {page-one}
+do_test pager2-2.28 {
+  set v [catch {
+    pager_rollback $::p1
+  } msg]
+  lappend v $msg
+} {0 {}}
+do_test pager2-2.29 {
+  page_unref $::g1
+  set ::g1 [page_get $::p1 1]
+  page_read $::g1
+} {Page-One}
+do_test pager2-2.99 {
+  page_unref $::g1
+} {}
+
+#do_test pager2-3.1 {
+#  set v [catch {
+#    set ::p1 [pager_open :memory: 15]
+#  } msg]
+#  if {$v} {lappend v $msg}
+#  set v
+#} {0}
+do_test pager2-3.2 {
+  pager_pagecount $::p1
+} {1}
+do_test pager2-3.3 {
+  set v [catch {
+    set ::g(1) [page_get $::p1 1]
+  } msg]
+  if {$v} {lappend v $msg}
+  set v
+} {0}
+do_test pager2-3.4 {
+  page_read $::g(1)
+} {Page-One}
+do_test pager2-3.5 {
+  for {set i 2} {$i<=20} {incr i} {
+    set gx [page_get $::p1 $i]
+    page_write $gx "Page-$i"
+    page_unref $gx
+  }
+  pager_commit $::p1
+  page_unref $::g(1)
+} {}
+for {set i 2} {$i<=20} {incr i} {
+  do_test pager2-3.6.[expr {$i-1}] [subst {
+    set gx \[page_get $::p1 $i\]
+    set v \[page_read \$gx\]
+    page_unref \$gx
+    set v
+  }] "Page-$i"
+}
+for {set i 1} {$i<=20} {incr i} {
+  regsub -all CNT {
+    set ::g1 [page_get $::p1 CNT]
+    set ::g2 [page_get $::p1 CNT]
+    set ::vx [page_read $::g2]
+    expr {$::g1==$::g2}
+  } $i body;
+  do_test pager2-3.7.$i.1 $body {1}
+  regsub -all CNT {
+    page_unref $::g2
+    set vy [page_read $::g1]
+    expr {$vy==$::vx}
+  } $i body;
+  do_test pager2-3.7.$i.2 $body {1}
+  regsub -all CNT {
+    page_unref $::g1
+    set gx [page_get $::p1 CNT]
+    set vy [page_read $gx]
+    page_unref $gx
+    expr {$vy==$::vx}
+  } $i body;
+  do_test pager2-3.7.$i.3 $body {1}
+}
+do_test pager2-3.99 {
+  pager_close $::p1
+} {}
+
+# tests of the checkpoint mechanism and api
+#
+do_test pager2-4.0 {
+  set v [catch {
+    set ::p1 [pager_open :memory: 15]
+  } msg]
+  if {$v} {lappend v $msg}
+  set v
+} {0}
+do_test pager2-4.1 {
+  set g1 [page_get $::p1 1]
+  page_write $g1 "Page-1 v0"
+  for {set i 2} {$i<=20} {incr i} {
+    set gx [page_get $::p1 $i]
+    page_write $gx "Page-$i v0"
+    page_unref $gx
+  }
+  pager_commit $::p1
+} {}
+for {set i 1} {$i<=20} {incr i} {
+  do_test pager2-4.2.$i {
+    set gx [page_get $p1 $i]
+    set v [page_read $gx]
+    page_unref $gx
+    set v
+  } "Page-$i v0"
+}
+do_test pager2-4.3 {
+  lrange [pager_stats $::p1] 0 1
+} {ref 1}
+do_test pager2-4.4 {
+  lrange [pager_stats $::p1] 8 9
+} {state 1}
+
+for {set i 1} {$i<20} {incr i} {
+  do_test pager2-4.5.$i.0 {
+    set res {}
+    for {set j 2} {$j<=20} {incr j} {
+      set gx [page_get $p1 $j]
+      set value [page_read $gx]
+      page_unref $gx
+      set shouldbe "Page-$j v[expr {$i-1}]"
+      if {$value!=$shouldbe} {
+        lappend res $value $shouldbe
+      }
+    }
+    set res
+  } {}
+  do_test pager2-4.5.$i.1 {
+    page_write $g1 "Page-1 v$i"
+    lrange [pager_stats $p1] 8 9
+  } {state 4}
+  do_test pager2-4.5.$i.2 {
+    for {set j 2} {$j<=20} {incr j} {
+      set gx [page_get $p1 $j]
+      page_write $gx "Page-$j v$i"
+      page_unref $gx
+      if {$j==$i} {
+        pager_stmt_begin $p1
+      }
+    }
+  } {}
+  do_test pager2-4.5.$i.3 {
+    set res {}
+    for {set j 2} {$j<=20} {incr j} {
+      set gx [page_get $p1 $j]
+      set value [page_read $gx]
+      page_unref $gx
+      set shouldbe "Page-$j v$i"
+      if {$value!=$shouldbe} {
+        lappend res $value $shouldbe
+      }
+    }
+    set res
+  } {}
+  do_test pager2-4.5.$i.4 {
+    pager_rollback $p1
+    set res {}
+    for {set j 2} {$j<=20} {incr j} {
+      set gx [page_get $p1 $j]
+      set value [page_read $gx]
+      page_unref $gx
+      set shouldbe "Page-$j v[expr {$i-1}]"
+      if {$value!=$shouldbe} {
+        lappend res $value $shouldbe
+      }
+    }
+    set res
+  } {}
+breakpoint
+  do_test pager2-4.5.$i.5 {
+    page_write $g1 "Page-1 v$i"
+    lrange [pager_stats $p1] 8 9
+  } {state 4}
+  do_test pager2-4.5.$i.6 {
+    for {set j 2} {$j<=20} {incr j} {
+      set gx [page_get $p1 $j]
+      page_write $gx "Page-$j v$i"
+      page_unref $gx
+      if {$j==$i} {
+        pager_stmt_begin $p1
+      }
+    }
+  } {}
+  do_test pager2-4.5.$i.7 {
+    pager_stmt_rollback $p1
+    for {set j 2} {$j<=20} {incr j} {
+      set gx [page_get $p1 $j]
+      set value [page_read $gx]
+      page_unref $gx
+      if {$j<=$i || $i==1} {
+        set shouldbe "Page-$j v$i"
+      } else {
+        set shouldbe "Page-$j v[expr {$i-1}]"
+      }
+      if {$value!=$shouldbe} {
+        lappend res $value $shouldbe
+      }
+    }
+    set res
+  } {}
+  do_test pager2-4.5.$i.8 {
+    for {set j 2} {$j<=20} {incr j} {
+      set gx [page_get $p1 $j]
+      page_write $gx "Page-$j v$i"
+      page_unref $gx
+      if {$j==$i} {
+        pager_stmt_begin $p1
+      }
+    }
+  } {}
+  do_test pager2-4.5.$i.9 {
+    pager_stmt_commit $p1
+    for {set j 2} {$j<=20} {incr j} {
+      set gx [page_get $p1 $j]
+      set value [page_read $gx]
+      page_unref $gx
+      set shouldbe "Page-$j v$i"
+      if {$value!=$shouldbe} {
+        lappend res $value $shouldbe
+      }
+    }
+    set res
+  } {}
+  do_test pager2-4.5.$i.10 {
+    pager_commit $p1
+    lrange [pager_stats $p1] 8 9
+  } {state 1}
+}
+
+do_test pager2-4.99 {
+  page_unref $::g1
+  pager_close $::p1
+} {}
+
+} ;# ifcapable inmemory
+} ;# end if( has pager_open command );
+
+
+finish_test