Import BSDDB 4.7.25 (as of svn r89086)
This commit is contained in:
Zachary Ware
146
test/sdb001.tcl
Normal file
146
test/sdb001.tcl
Normal file
@@ -0,0 +1,146 @@
|
||||
# See the file LICENSE for redistribution information.
|
||||
#
|
||||
# Copyright (c) 1999,2008 Oracle. All rights reserved.
|
||||
#
|
||||
# $Id: sdb001.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
|
||||
#
|
||||
# TEST sdb001 Tests mixing db and subdb operations
|
||||
# TEST Tests mixing db and subdb operations
|
||||
# TEST Create a db, add data, try to create a subdb.
|
||||
# TEST Test naming db and subdb with a leading - for correct parsing
|
||||
# TEST Existence check -- test use of -excl with subdbs
|
||||
# TEST
|
||||
# TEST Test non-subdb and subdb operations
|
||||
# TEST Test naming (filenames begin with -)
|
||||
# TEST Test existence (cannot create subdb of same name with -excl)
|
||||
proc sdb001 { method args } {
|
||||
source ./include.tcl
|
||||
global errorInfo
|
||||
|
||||
set args [convert_args $method $args]
|
||||
set omethod [convert_method $method]
|
||||
|
||||
if { [is_queue $method] == 1 } {
|
||||
puts "Subdb001: skipping for method $method"
|
||||
return
|
||||
}
|
||||
puts "Subdb001: $method ($args) subdb and non-subdb tests"
|
||||
|
||||
set testfile $testdir/subdb001.db
|
||||
set eindex [lsearch -exact $args "-env"]
|
||||
if { $eindex != -1 } {
|
||||
set env NULL
|
||||
incr eindex
|
||||
set env [lindex $args $eindex]
|
||||
puts "Subdb001 skipping for env $env"
|
||||
return
|
||||
}
|
||||
# Create the database and open the dictionary
|
||||
set subdb subdb0
|
||||
cleanup $testdir NULL
|
||||
puts "\tSubdb001.a: Non-subdb database and subdb operations"
|
||||
#
|
||||
# Create a db with no subdbs. Add some data. Close. Try to
|
||||
# open/add with a subdb. Should fail.
|
||||
#
|
||||
puts "\tSubdb001.a.0: Create db, add data, close, try subdb"
|
||||
set db [eval {berkdb_open -create -mode 0644} \
|
||||
$args {$omethod $testfile}]
|
||||
error_check_good dbopen [is_valid_db $db] TRUE
|
||||
|
||||
set did [open $dict]
|
||||
|
||||
set pflags ""
|
||||
set gflags ""
|
||||
set count 0
|
||||
|
||||
if { [is_record_based $method] == 1 } {
|
||||
append gflags " -recno"
|
||||
}
|
||||
while { [gets $did str] != -1 && $count < 5 } {
|
||||
if { [is_record_based $method] == 1 } {
|
||||
global kvals
|
||||
|
||||
set key [expr $count + 1]
|
||||
set kvals($key) $str
|
||||
} else {
|
||||
set key $str
|
||||
}
|
||||
set ret [eval \
|
||||
{$db put} $pflags {$key [chop_data $method $str]}]
|
||||
error_check_good put $ret 0
|
||||
|
||||
set ret [eval {$db get} $gflags {$key}]
|
||||
error_check_good \
|
||||
get $ret [list [list $key [pad_data $method $str]]]
|
||||
incr count
|
||||
}
|
||||
close $did
|
||||
error_check_good db_close [$db close] 0
|
||||
set ret [catch {eval {berkdb_open_noerr -create -mode 0644} $args \
|
||||
{$omethod $testfile $subdb}} db]
|
||||
error_check_bad dbopen $ret 0
|
||||
#
|
||||
# Create a db with no subdbs. Add no data. Close. Try to
|
||||
# open/add with a subdb. Should fail.
|
||||
#
|
||||
set testfile $testdir/subdb001a.db
|
||||
puts "\tSubdb001.a.1: Create db, close, try subdb"
|
||||
#
|
||||
# !!!
|
||||
# Using -truncate is illegal when opening for subdbs, but we
|
||||
# can use it here because we are not using subdbs for this
|
||||
# create.
|
||||
#
|
||||
set db [eval {berkdb_open -create -truncate -mode 0644} $args \
|
||||
{$omethod $testfile}]
|
||||
error_check_good dbopen [is_valid_db $db] TRUE
|
||||
error_check_good db_close [$db close] 0
|
||||
|
||||
set ret [catch {eval {berkdb_open_noerr -create -mode 0644} $args \
|
||||
{$omethod $testfile $subdb}} db]
|
||||
error_check_bad dbopen $ret 0
|
||||
|
||||
if { [is_queue $method] == 1 } {
|
||||
puts "Subdb001: skipping remainder of test for method $method"
|
||||
return
|
||||
}
|
||||
|
||||
#
|
||||
# Test naming, db and subdb names beginning with -.
|
||||
#
|
||||
puts "\tSubdb001.b: Naming"
|
||||
set cwd [pwd]
|
||||
cd $testdir
|
||||
set testfile1 -subdb001.db
|
||||
set subdb -subdb
|
||||
puts "\tSubdb001.b.0: Create db and subdb with -name, no --"
|
||||
set ret [catch {eval {berkdb_open -create -mode 0644} $args \
|
||||
{$omethod $testfile1 $subdb}} db]
|
||||
error_check_bad dbopen $ret 0
|
||||
puts "\tSubdb001.b.1: Create db and subdb with -name, with --"
|
||||
set db [eval {berkdb_open -create -mode 0644} $args \
|
||||
{$omethod -- $testfile1 $subdb}]
|
||||
error_check_good dbopen [is_valid_db $db] TRUE
|
||||
error_check_good db_close [$db close] 0
|
||||
|
||||
cd $cwd
|
||||
|
||||
#
|
||||
# Create 1 db with 1 subdb. Try to create another subdb of
|
||||
# the same name. Should fail.
|
||||
#
|
||||
|
||||
puts "\tSubdb001.c: Existence check"
|
||||
set testfile $testdir/subdb001d.db
|
||||
set subdb subdb
|
||||
set ret [catch {eval {berkdb_open -create -excl -mode 0644} $args \
|
||||
{$omethod $testfile $subdb}} db]
|
||||
error_check_good dbopen [is_valid_db $db] TRUE
|
||||
set ret [catch {eval {berkdb_open_noerr -create -excl -mode 0644} \
|
||||
$args {$omethod $testfile $subdb}} db1]
|
||||
error_check_bad dbopen $ret 0
|
||||
error_check_good db_close [$db close] 0
|
||||
|
||||
return
|
||||
}
|
||||
Reference in New Issue
Block a user