1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1999,2008 Oracle.  All rights reserved.
4#
5# $Id: sdb001.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	sdb001	Tests mixing db and subdb operations
8# TEST	Tests mixing db and subdb operations
9# TEST	Create a db, add data, try to create a subdb.
10# TEST	Test naming db and subdb with a leading - for correct parsing
11# TEST	Existence check -- test use of -excl with subdbs
12# TEST
13# TEST	Test non-subdb and subdb operations
14# TEST	Test naming (filenames begin with -)
15# TEST	Test existence (cannot create subdb of same name with -excl)
16proc sdb001 { method args } {
17	source ./include.tcl
18	global errorInfo
19
20	set args [convert_args $method $args]
21	set omethod [convert_method $method]
22
23	if { [is_queue $method] == 1 } {
24		puts "Subdb001: skipping for method $method"
25		return
26	}
27	puts "Subdb001: $method ($args) subdb and non-subdb tests"
28
29	set testfile $testdir/subdb001.db
30	set eindex [lsearch -exact $args "-env"]
31	if { $eindex != -1 } {
32		set env NULL
33		incr eindex
34		set env [lindex $args $eindex]
35		puts "Subdb001 skipping for env $env"
36		return
37	}
38	# Create the database and open the dictionary
39	set subdb subdb0
40	cleanup $testdir NULL
41	puts "\tSubdb001.a: Non-subdb database and subdb operations"
42	#
43	# Create a db with no subdbs.  Add some data.  Close.  Try to
44	# open/add with a subdb.  Should fail.
45	#
46	puts "\tSubdb001.a.0: Create db, add data, close, try subdb"
47	set db [eval {berkdb_open -create -mode 0644} \
48	    $args {$omethod $testfile}]
49	error_check_good dbopen [is_valid_db $db] TRUE
50
51	set did [open $dict]
52
53	set pflags ""
54	set gflags ""
55	set count 0
56
57	if { [is_record_based $method] == 1 } {
58		append gflags " -recno"
59	}
60	while { [gets $did str] != -1 && $count < 5 } {
61		if { [is_record_based $method] == 1 } {
62			global kvals
63
64			set key [expr $count + 1]
65			set kvals($key) $str
66		} else {
67			set key $str
68		}
69		set ret [eval \
70		    {$db put} $pflags {$key [chop_data $method $str]}]
71		error_check_good put $ret 0
72
73		set ret [eval {$db get} $gflags {$key}]
74		error_check_good \
75		    get $ret [list [list $key [pad_data $method $str]]]
76		incr count
77	}
78	close $did
79	error_check_good db_close [$db close] 0
80	set ret [catch {eval {berkdb_open_noerr -create -mode 0644} $args \
81	    {$omethod $testfile $subdb}} db]
82	error_check_bad dbopen $ret 0
83	#
84	# Create a db with no subdbs.  Add no data.  Close.  Try to
85	# open/add with a subdb.  Should fail.
86	#
87	set testfile $testdir/subdb001a.db
88	puts "\tSubdb001.a.1: Create db, close, try subdb"
89	#
90	# !!!
91	# Using -truncate is illegal when opening for subdbs, but we
92	# can use it here because we are not using subdbs for this
93	# create.
94	#
95	set db [eval {berkdb_open -create -truncate -mode 0644} $args \
96	    {$omethod $testfile}]
97	error_check_good dbopen [is_valid_db $db] TRUE
98	error_check_good db_close [$db close] 0
99
100	set ret [catch {eval {berkdb_open_noerr -create -mode 0644} $args \
101	    {$omethod $testfile $subdb}} db]
102	error_check_bad dbopen $ret 0
103
104	if { [is_queue $method] == 1 } {
105		puts "Subdb001: skipping remainder of test for method $method"
106		return
107	}
108
109	#
110	# Test naming, db and subdb names beginning with -.
111	#
112	puts "\tSubdb001.b: Naming"
113	set cwd [pwd]
114	cd $testdir
115	set testfile1 -subdb001.db
116	set subdb -subdb
117	puts "\tSubdb001.b.0: Create db and subdb with -name, no --"
118	set ret [catch {eval {berkdb_open -create -mode 0644} $args \
119	    {$omethod $testfile1 $subdb}} db]
120	error_check_bad dbopen $ret 0
121	puts "\tSubdb001.b.1: Create db and subdb with -name, with --"
122	set db [eval {berkdb_open -create -mode 0644} $args \
123	    {$omethod -- $testfile1 $subdb}]
124	error_check_good dbopen [is_valid_db $db] TRUE
125	error_check_good db_close [$db close] 0
126
127	cd $cwd
128
129	#
130	# Create 1 db with 1 subdb.  Try to create another subdb of
131	# the same name.  Should fail.
132	#
133
134	puts "\tSubdb001.c: Existence check"
135	set testfile $testdir/subdb001d.db
136	set subdb subdb
137	set ret [catch {eval {berkdb_open -create -excl -mode 0644} $args \
138	    {$omethod $testfile $subdb}} db]
139	error_check_good dbopen [is_valid_db $db] TRUE
140	set ret [catch {eval {berkdb_open_noerr -create -excl -mode 0644} \
141	    $args {$omethod $testfile $subdb}} db1]
142	error_check_bad dbopen $ret 0
143	error_check_good db_close [$db close] 0
144
145	return
146}
147