1# Copyright (c) 1999, 2020 Oracle and/or its affiliates. All rights reserved. 2# 3# See the file LICENSE for license information. 4# 5# $Id$ 6# 7# TEST sdb004 8# TEST Tests large subdb names 9# TEST subdb name = filecontents, 10# TEST key = filename, data = filecontents 11# TEST Put/get per key 12# TEST Dump file 13# TEST Dump subdbs, verify data and subdb name match 14# TEST 15# TEST Create 1 db with many large subdbs. Use the contents as subdb names. 16# TEST Take the source files and dbtest executable and enter their names as 17# TEST the key with their contents as data. After all are entered, retrieve 18# TEST all; compare output to original. Close file, reopen, do retrieve and 19# TEST re-verify. 20proc sdb004 { method args} { 21 global names 22 source ./include.tcl 23 24 set args [convert_args $method $args] 25 set omethod [convert_method $method] 26 27 if { [is_queue $method] == 1 || \ 28 [is_heap $method] == 1 || [is_fixed_length $method] == 1 } { 29 puts "Subdb004: skipping for method $method" 30 return 31 } 32 33 puts "Subdb004: $method ($args) \ 34 filecontents=subdbname filename=key filecontents=data pairs" 35 36 set txnenv 0 37 set envargs "" 38 set eindex [lsearch -exact $args "-env"] 39 # 40 # If we are using an env, then testfile should just be the db name. 41 # Otherwise it is the test directory and the name. 42 if { $eindex == -1 } { 43 set testfile $testdir/subdb004.db 44 set env NULL 45 } else { 46 set testfile subdb004.db 47 incr eindex 48 set env [lindex $args $eindex] 49 set envargs " -env $env " 50 set txnenv [is_txnenv $env] 51 if { $txnenv == 1 } { 52 append args " -auto_commit " 53 append envargs " -auto_commit " 54 } 55 set testdir [get_home $env] 56 } 57 # Create the database and open the dictionary 58 set t1 $testdir/t1 59 set t2 $testdir/t2 60 set t3 $testdir/t3 61 set t4 $testdir/t4 62 63 cleanup $testdir $env 64 set pflags "" 65 set gflags "" 66 set txn "" 67 if { [is_record_based $method] == 1 } { 68 set checkfunc subdb004_recno.check 69 append gflags "-recno" 70 } else { 71 set checkfunc subdb004.check 72 } 73 74 # Here is the loop where we put and get each key/data pair 75 # Note that the subdatabase name is passed in as a char *, not 76 # in a DBT, so it may not contain nulls; use only source files. 77 set file_list [glob $src_root/*/*.c $src_root/*/*/*.c \ 78 $src_root/*/*/*/*.c $src_root/*/*/*/*/*.c \ 79 $src_root/*/*/*/*/*/*.c] 80 set fcount [llength $file_list] 81 if { $txnenv == 1 && $fcount > 100 } { 82 set file_list [lrange $file_list 0 99] 83 set fcount 100 84 } 85 86 set count 0 87 if { [is_record_based $method] == 1 } { 88 set oid [open $t2 w] 89 for {set i 1} {$i <= $fcount} {set i [incr i]} { 90 puts $oid $i 91 } 92 close $oid 93 } else { 94 set oid [open $t2.tmp w] 95 foreach f $file_list { 96 puts $oid $f 97 } 98 close $oid 99 filesort $t2.tmp $t2 100 } 101 puts "\tSubdb004.a: Set/Check each subdb" 102 foreach f $file_list { 103 if { [is_record_based $method] == 1 } { 104 set key [expr $count + 1] 105 set names([expr $count + 1]) $f 106 } else { 107 set key $f 108 } 109 # Should really catch errors 110 set fid [open $f r] 111 fconfigure $fid -translation binary 112 set data [read $fid] 113 set subdb $data 114 close $fid 115 set db [eval {berkdb_open -create -mode 0644} \ 116 $args {$omethod $testfile $subdb}] 117 error_check_good dbopen [is_valid_db $db] TRUE 118 if { $txnenv == 1 } { 119 set t [$env txn] 120 error_check_good txn [is_valid_txn $t $env] TRUE 121 set txn "-txn $t" 122 } 123 set ret [eval \ 124 {$db put} $txn $pflags {$key [chop_data $method $data]}] 125 error_check_good put $ret 0 126 if { $txnenv == 1 } { 127 error_check_good txn [$t commit] 0 128 } 129 130 # Should really catch errors 131 set fid [open $t4 w] 132 fconfigure $fid -translation binary 133 if [catch {eval {$db get} $gflags {$key}} data] { 134 puts -nonewline $fid $data 135 } else { 136 # Data looks like {{key data}} 137 set key [lindex [lindex $data 0] 0] 138 set data [lindex [lindex $data 0] 1] 139 puts -nonewline $fid $data 140 } 141 close $fid 142 143 error_check_good Subdb004:diff($f,$t4) \ 144 [filecmp $f $t4] 0 145 146 incr count 147 148 # Now we will get each key from the DB and compare the results 149 # to the original. 150 # puts "\tSubdb004.b: dump file" 151 if { $txnenv == 1 } { 152 set t [$env txn] 153 error_check_good txn [is_valid_txn $t $env] TRUE 154 set txn "-txn $t" 155 } 156 dump_bin_file $db $txn $t1 $checkfunc 157 if { $txnenv == 1 } { 158 error_check_good txn [$t commit] 0 159 } 160 error_check_good db_close [$db close] 0 161 162 } 163 164 # 165 # Now for each file, check that the subdb name is the same 166 # as the data in that subdb and that the filename is the key. 167 # 168 puts "\tSubdb004.b: Compare subdb names with key/data" 169 set db [eval {berkdb_open -rdonly} $envargs {$testfile}] 170 error_check_good dbopen [is_valid_db $db] TRUE 171 if { $txnenv == 1 } { 172 set t [$env txn] 173 error_check_good txn [is_valid_txn $t $env] TRUE 174 set txn "-txn $t" 175 } 176 set c [eval {$db cursor} $txn] 177 error_check_good db_cursor [is_valid_cursor $c $db] TRUE 178 179 for {set d [$c get -first] } { [llength $d] != 0 } \ 180 {set d [$c get -next] } { 181 set subdbname [lindex [lindex $d 0] 0] 182 set subdb [eval {berkdb_open} $args {$testfile $subdbname}] 183 error_check_good dbopen [is_valid_db $db] TRUE 184 185 # Output the subdb name 186 set ofid [open $t3 w] 187 fconfigure $ofid -translation binary 188 if { [string compare "\0" \ 189 [string range $subdbname end end]] == 0 } { 190 set slen [expr [string length $subdbname] - 2] 191 set subdbname [string range $subdbname 1 $slen] 192 } 193 puts -nonewline $ofid $subdbname 194 close $ofid 195 196 # Output the data 197 set subc [eval {$subdb cursor} $txn] 198 error_check_good db_cursor [is_valid_cursor $subc $subdb] TRUE 199 set d [$subc get -first] 200 error_check_good dbc_get [expr [llength $d] != 0] 1 201 set key [lindex [lindex $d 0] 0] 202 set data [lindex [lindex $d 0] 1] 203 204 set ofid [open $t1 w] 205 fconfigure $ofid -translation binary 206 puts -nonewline $ofid $data 207 close $ofid 208 209 $checkfunc $key $t1 210 $checkfunc $key $t3 211 212 error_check_good Subdb004:diff($t3,$t1) \ 213 [filecmp $t3 $t1] 0 214 error_check_good curs_close [$subc close] 0 215 error_check_good db_close [$subdb close] 0 216 } 217 error_check_good curs_close [$c close] 0 218 if { $txnenv == 1 } { 219 error_check_good txn [$t commit] 0 220 } 221 error_check_good db_close [$db close] 0 222 223 if { [is_record_based $method] != 1 } { 224 fileremove $t2.tmp 225 } 226} 227 228# Check function for subdb004; key should be file name; data should be contents 229proc subdb004.check { binfile tmpfile } { 230 source ./include.tcl 231 232 error_check_good Subdb004:datamismatch($binfile,$tmpfile) \ 233 [filecmp $binfile $tmpfile] 0 234} 235proc subdb004_recno.check { binfile tmpfile } { 236 global names 237 source ./include.tcl 238 239 set fname $names($binfile) 240 error_check_good key"$binfile"_exists [info exists names($binfile)] 1 241 error_check_good Subdb004:datamismatch($fname,$tmpfile) \ 242 [filecmp $fname $tmpfile] 0 243} 244