# 2001 September 15
#
# Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.
#
# 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: pager.test,v 1.31 2008/08/20 14:49:25 danielk1977 Exp $


set testdir [file dirname $argv0]
source $testdir/tester.tcl

if {[info commands pager_open]!=""} {
db close

# Basic sanity check.  Open and close a pager.
#
do_test pager-1.0 {
  catch {file delete -force ptf1.db}
  catch {file delete -force ptf1.db-journal}
  set v [catch {
    set ::p1 [pager_open ptf1.db 10]
  } msg]
} {0}
do_test pager-1.1 {
  pager_stats $::p1
} {ref 0 page 0 max 10 size -1 state 0 err 0 hit 0 miss 0 ovfl 0}
do_test pager-1.2 {
  pager_pagecount $::p1
} {0}
do_test pager-1.3 {
  pager_stats $::p1
} {ref 0 page 0 max 10 size -1 state 0 err 0 hit 0 miss 0 ovfl 0}
do_test pager-1.4 {
  pager_close $::p1
} {}

# Try to write a few pages.
#
do_test pager-2.1 {
  set v [catch {
    set ::p1 [pager_open ptf1.db 10]
  } msg]
} {0}
#do_test pager-2.2 {
#  set v [catch {
#    set ::g1 [page_get $::p1 0]
#  } msg]
#  lappend v $msg
#} {1 SQLITE_ERROR}
do_test pager-2.3.1 {
  set ::gx [page_lookup $::p1 1]
} {}
do_test pager-2.3.2 {
  pager_stats $::p1
} {ref 0 page 0 max 10 size -1 state 0 err 0 hit 0 miss 0 ovfl 0}
do_test pager-2.3.3 {
  set v [catch {
    set ::g1 [page_get $::p1 1]
  } msg]
  if {$v} {lappend v $msg}
  set v
} {0}
do_test pager-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 pager-2.3.4 {
  set ::gx [page_lookup $::p1 1]
  expr {$::gx!=""}
} {1}
do_test pager-2.3.5 {
  page_unref $::gx
  pager_stats $::p1
} {ref 1 page 1 max 10 size 0 state 1 err 0 hit 0 miss 1 ovfl 0}
do_test pager-2.3.6 {
  expr {$::g1==$::gx}
} {1}
do_test pager-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 pager-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 pager-2.5 {
  pager_pagecount $::p1
} {0}
do_test pager-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 pager-2.7 {
  page_number $::g1
} {1}
do_test pager-2.8 {
  page_read $::g1
} {}
do_test pager-2.9 {
  page_unref $::g1
} {}

# Update 24/03/2007: Even though the ref-count has dropped to zero, the
# pager-cache still contains some pages. Previously, it was always true
# that if there were no references to a pager it was empty.
do_test pager-2.10 {
  pager_stats $::p1
} {ref 0 page 1 max 10 size -1 state 0 err 0 hit 0 miss 1 ovfl 0}
do_test pager-2.11 {
  set ::g1 [page_get $::p1 1]
  expr {$::g1!=0}
} {1}
do_test pager-2.12 {
  page_number $::g1
} {1}
do_test pager-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 pager-2.14 {
  set v [catch {
    page_write $::g1 "Page-One"
  } msg]
  lappend v $msg
} {0 {}}
do_test pager-2.15 {
  pager_stats $::p1
} {ref 1 page 1 max 10 size 1 state 2 err 0 hit 1 miss 1 ovfl 0}
do_test pager-2.16 {
  page_read $::g1
} {Page-One}
do_test pager-2.17 {
  set v [catch {
    pager_commit $::p1
  } msg]
  lappend v $msg
} {0 {}}
do_test pager-2.20 {
  pager_stats $::p1
} {ref 1 page 1 max 10 size -1 state 1 err 0 hit 2 miss 1 ovfl 0}
do_test pager-2.19 {
  pager_pagecount $::p1
} {1}
do_test pager-2.21 {
  pager_stats $::p1
} {ref 1 page 1 max 10 size 1 state 1 err 0 hit 2 miss 1 ovfl 0}
do_test pager-2.22 {
  page_unref $::g1
} {}
do_test pager-2.23 {
  pager_stats $::p1
} {ref 0 page 1 max 10 size -1 state 0 err 0 hit 2 miss 1 ovfl 0}
do_test pager-2.24 {
  set v [catch {
    page_get $::p1 1
  } ::g1]
  if {$v} {lappend v $::g1}
  set v
} {0}
do_test pager-2.25 {
  page_read $::g1
} {Page-One}
do_test pager-2.26 {
  set v [catch {
    page_write $::g1 {page-one}
  } msg]
  lappend v $msg
} {0 {}}
do_test pager-2.27 {
  page_read $::g1
} {page-one}
do_test pager-2.28 {
  set v [catch {
    pager_rollback $::p1
  } msg]
  lappend v $msg
} {0 {}}
do_test pager-2.29 {
  page_unref $::g1
  set ::g1 [page_get $::p1 1]
  page_read $::g1
} {Page-One}
do_test pager-2.99 {
  page_unref $::g1
  pager_close $::p1
} {}

do_test pager-3.1 {
  set v [catch {
    set ::p1 [pager_open ptf1.db 15]
  } msg]
  if {$v} {lappend v $msg}
  set v
} {0}
do_test pager-3.2 {
  pager_pagecount $::p1
} {1}
do_test pager-3.3 {
  set v [catch {
    set ::g(1) [page_get $::p1 1]
  } msg]
  if {$v} {lappend v $msg}
  set v
} {0}
do_test pager-3.4 {
  page_read $::g(1)
} {Page-One}
do_test pager-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 pager-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 pager-3.7.$i.1 $body {1}
  regsub -all CNT {
    page_unref $::g2
    set vy [page_read $::g1]
    expr {$vy==$::vx}
  } $i body;
  do_test pager-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 pager-3.7.$i.3 $body {1}
}
do_test pager-3.99 {
  pager_close $::p1
} {}

# tests of the checkpoint mechanism and api
#
do_test pager-4.0 {
  set v [catch {
    file delete -force ptf1.db
    set ::p1 [pager_open ptf1.db 15]
  } msg]
  if {$v} {lappend v $msg}
  set v
} {0}
do_test pager-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 pager-4.2.$i {
    set gx [page_get $p1 $i]
    set v [page_read $gx]
    page_unref $gx
    set v
  } "Page-$i v0"
}
do_test pager-4.3 {
  lrange [pager_stats $::p1] 0 1
} {ref 1}
do_test pager-4.4 {
  lrange [pager_stats $::p1] 8 9
} {state 1}

for {set i 1} {$i<20} {incr i} {
  do_test pager-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 pager-4.5.$i.1 {
    page_write $g1 "Page-1 v$i"
    lrange [pager_stats $p1] 8 9
  } {state 2}
  do_test pager-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 pager-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 pager-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
  } {}
  do_test pager-4.5.$i.5 {
    page_write $g1 "Page-1 v$i"
    lrange [pager_stats $p1] 8 9
  } {state 2}
  do_test pager-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 pager-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 pager-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 pager-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 pager-4.5.$i.10 {
    pager_commit $p1
    lrange [pager_stats $p1] 8 9
  } {state 1}
}

# Test that nothing bad happens when sqlite3pager_set_cachesize() is
# called with a negative argument.
do_test pager-4.6.1 {
  pager_close [pager_open ptf2.db -15]
} {}

# Test truncate on an in-memory database is Ok.
ifcapable memorydb {
  do_test pager-4.6.2 {
    set ::p2 [pager_open :memory: 10]
    pager_truncate $::p2 5
  } {}
  do_test pager-4.6.3 {
    for {set i 1} {$i<5} {incr i} {
      set p [page_get $::p2 $i]
      page_write $p "Page $i"
      pager_commit $::p2
      page_unref $p
    }
    # pager_truncate $::p2 3
  } {}
  do_test pager-4.6.4 {
    pager_close $::p2
  } {}
}

do_test pager-4.99 {
  page_unref $::g1
  pager_close $::p1
} {}



  file delete -force ptf1.db

} ;# end if( not mem: and has pager_open command );

if 0 {
# Ticket #615: an assertion fault inside the pager.  It is a benign
# fault, but we might as well test for it.
#
do_test pager-5.1 {
  sqlite3 db test.db
  execsql {
    BEGIN;
    CREATE TABLE t1(x);
    PRAGMA synchronous=off;
    COMMIT;
  }
} {}
}

# The following tests cover rolling back hot journal files. 
# They can't be run on windows because the windows version of 
# SQLite holds a mandatory exclusive lock on journal files it has open.
#
if {$tcl_platform(platform)!="windows" && $tcl_platform(platform)!="symbian"} {
do_test pager-6.1 {
  file delete -force test2.db
  file delete -force test2.db-journal
  sqlite3 db2 test2.db
  execsql {
    PRAGMA synchronous = 0;
    CREATE TABLE abc(a, b, c);
    INSERT INTO abc VALUES(1, 2, randstr(200,200));
    INSERT INTO abc VALUES(1, 2, randstr(200,200));
    INSERT INTO abc VALUES(1, 2, randstr(200,200));
    INSERT INTO abc VALUES(1, 2, randstr(200,200));
    INSERT INTO abc VALUES(1, 2, randstr(200,200));
    INSERT INTO abc VALUES(1, 2, randstr(200,200));
    INSERT INTO abc VALUES(1, 2, randstr(200,200));
    INSERT INTO abc VALUES(1, 2, randstr(200,200));
    INSERT INTO abc VALUES(1, 2, randstr(200,200));
    BEGIN;
    UPDATE abc SET c = randstr(200,200);
  } db2
  copy_file test2.db test.db
  copy_file test2.db-journal test.db-journal

  set f [open test.db-journal a]
  fconfigure $f -encoding binary
  seek $f [expr [file size test.db-journal] - 1032] start
  puts -nonewline $f "\00\00\00\00"
  close $f

  sqlite3 db test.db
  execsql {
    SELECT sql FROM sqlite_master
  }
} {{CREATE TABLE abc(a, b, c)}}

do_test pager-6.2 {
  copy_file test2.db test.db
  copy_file test2.db-journal test.db-journal

  set f [open test.db-journal a]
  fconfigure $f -encoding binary
  seek $f [expr [file size test.db-journal] - 1032] start
  puts -nonewline $f "\00\00\00\FF"
  close $f

  sqlite3 db test.db
  execsql {
    SELECT sql FROM sqlite_master
  }
} {{CREATE TABLE abc(a, b, c)}}

do_test pager-6.3 {
  copy_file test2.db test.db
  copy_file test2.db-journal test.db-journal

  set f [open test.db-journal a]
  fconfigure $f -encoding binary
  seek $f [expr [file size test.db-journal] - 4] start
  puts -nonewline $f "\00\00\00\00"
  close $f

  sqlite3 db test.db
  execsql {
    SELECT sql FROM sqlite_master
  }
} {{CREATE TABLE abc(a, b, c)}}

do_test pager-6.4.1 {
  execsql {
    BEGIN;
    SELECT sql FROM sqlite_master;
  }
  copy_file test2.db-journal test.db-journal;
  sqlite3 db3 test.db
  catchsql {
    BEGIN;
    SELECT sql FROM sqlite_master;
  } db3;
} {1 {database is locked}}
do_test pager-6.4.2 {
  file delete -force test.db-journal
  catchsql {
    SELECT sql FROM sqlite_master;
  } db3;
} {0 {{CREATE TABLE abc(a, b, c)}}}
do_test pager-6.4.3 {
  db3 close
  execsql {
    COMMIT;
  }
} {}

do_test pager-6.5 {
  copy_file test2.db test.db
  copy_file test2.db-journal test.db-journal

  set f [open test.db-journal a]
  fconfigure $f -encoding binary
  puts -nonewline $f "hello"
  puts -nonewline $f "\x00\x00\x00\x05\x01\x02\x03\x04"
  puts -nonewline $f "\xd9\xd5\x05\xf9\x20\xa1\x63\xd7"
  close $f

  sqlite3 db test.db
  execsql {
    SELECT sql FROM sqlite_master
  }
} {{CREATE TABLE abc(a, b, c)}}

do_test pager-6.5 {
  db2 close
} {}
}
finish_test