File: bdb_util.tcl

package info (click to toggle)
db5.3 5.3.28%2Bdfsg2-9
  • links: PTS, VCS
  • area: main
  • in suites: trixie
  • size: 158,620 kB
  • sloc: ansic: 448,573; java: 111,824; tcl: 80,544; sh: 44,264; cs: 33,697; cpp: 21,600; perl: 14,557; xml: 10,799; makefile: 4,028; javascript: 1,998; yacc: 1,003; awk: 965; sql: 801; erlang: 342; python: 216; php: 24; asm: 14
file content (95 lines) | stat: -rw-r--r-- 2,826 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
#
#    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.
#
#***********************************************************************
# Utility functions for bdb tests.

source $testdir/tester.tcl
source $testdir/../../../../test/tcl_utils/multi_proc_utils.tcl
source $testdir/../../../../test/tcl_utils/common_test_utils.tcl

# 
# Functions for threads that return SQLITE_LOCK error when caught
set ::bdb_thread_procs { 
  proc execsql {sql} {
    set rc SQLITE_OK
    set err [catch {
      set ::STMT [sqlite3_prepare_v2 $::DB $sql -1 dummy_tail]
    } msg]

    if {$err == 0} {
      while {[set rc [sqlite3_step $::STMT]] eq "SQLITE_ROW"} {}
      set rc [sqlite3_finalize $::STMT]
    } else {
      if {[lindex $msg 0]=="(6)"} {
        set rc SQLITE_LOCKED
      } else {
        set rc SQLITE_ERROR
      }
    }

    if {[string first locked [sqlite3_errmsg $::DB]]>=0} {
      set rc SQLITE_LOCKED
    }
    if {$rc ne "SQLITE_OK" && $rc ne "SQLITE_LOCKED"} {
      set errtxt "$rc - [sqlite3_errmsg $::DB] (debug1)"
    }
    set rc
  }

  proc do_test {name script result} {
    set res [eval $script]
    if {$res ne $result} {
      puts "$name failed: expected \"$result\" got \"$res\""
      error "$name failed: expected \"$result\" got \"$res\""
    }
  }
}

#
# This procedure sets up three sites and databases suitable for replication
# testing.  The databases are created in separate subdirectories of the
# current working directory.
#
# This procedure populates global variables for each site's network
# address (host:port) and each site's directory for later use in tests.
# It uses the standard sqlite testing databases: db, db2 and db3.
#
proc setup_rep_sites {} {
	global site1addr site2addr site3addr site1dir site2dir site3dir

	# Get free ports in safe range for most platforms.
	set ports [available_ports 3]

	# Set up site1 directory and database.
	set site1dir ./repsite1
	catch {db close}
	file delete -force $site1dir/rep.db
	file delete -force $site1dir/rep.db-journal
	file delete -force $site1dir
	file mkdir $site1dir
	sqlite3 db $site1dir/rep.db
	set site1addr "127.0.0.1:[lindex $ports 0]"

	# Set up site2 directory and database.
	set site2dir ./repsite2
	catch {db2 close}
	file delete -force $site2dir/rep.db
	file delete -force $site2dir/rep.db-journal
	file delete -force $site2dir
	file mkdir $site2dir
	sqlite3 db2 $site2dir/rep.db
	set site2addr "127.0.0.1:[lindex $ports 1]"

	# Set up site3 directory and database.
	set site3dir ./repsite3
	catch {db3 close}
	file delete -force $site3dir/rep.db
	file delete -force $site3dir/rep.db-journal
	file delete -force $site3dir
	file mkdir $site3dir
	sqlite3 db3 $site3dir/rep.db
	set site3addr "127.0.0.1:[lindex $ports 2]"
}