File: portable.tcl

package info (click to toggle)
db5.3 5.3.28%2Bdfsg2-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 158,500 kB
  • sloc: ansic: 448,411; java: 111,824; tcl: 80,544; sh: 44,264; cs: 33,697; cpp: 21,604; perl: 14,557; xml: 10,799; makefile: 4,077; javascript: 1,998; yacc: 1,003; awk: 965; sql: 801; erlang: 342; python: 216; php: 24; asm: 14
file content (363 lines) | stat: -rw-r--r-- 9,341 bytes parent folder | download | duplicates (9)
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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
# See the file LICENSE for redistribution information.
#
# Copyright (c) 2011, 2013 Oracle and/or its affiliates.  All rights reserved.
#
# $Id$

source ./include.tcl

global gen_portable
set gen_portable 0

global portable_dir
global portable_be
global portable_method
global portable_name

proc test_portable_logs { { archived_test_loc } } {
	source ./include.tcl
	global test_names
	global portable_dir
	global tcl_platform
	global saved_logvers

	if { [string match /* $archived_test_loc] != 1 } {
		puts "Specify an absolute path for the archived files."
		return
	}

	# Identify endianness of the machine we are testing on.
	if { [big_endian] } {
		set myendianness be
	} else {
		set myendianness le
	}

	if { [file exists $archived_test_loc/logversion] == 1 } {
		set fd [open $archived_test_loc/logversion r]
		set saved_logvers [read $fd]
		close $fd
	} else {
		puts "Old log version number must be available \
		    in $archived_test_loc/logversion"
		return
	}

	fileremove -f PORTABLE.OUT
	set o [open PORTABLE.OUT a]

	puts -nonewline $o "Log portability test started at: "
	puts $o [clock format [clock seconds] -format "%H:%M %D"]
	puts $o [berkdb version -string]

	puts -nonewline "Log portability test started at: "
	puts [clock format [clock seconds] -format "%H:%M %D"]
	puts [berkdb version -string]

	set portable_dir $archived_test_loc
	puts $o "Using archived databases in $portable_dir."
	puts "Using archived databases in $portable_dir."
	close $o

foreach version [glob $portable_dir/*] {
	regexp \[^\/\]*$ $version version
	if { [string equal $version "logversion"] == 1 } { continue }

	# Test only files where the endianness of the db does
	# not match the endianness of the test platform. 
	#
	set dbendianness [string range $version end-1 end]
	if { [string equal $myendianness $dbendianness] } {
		puts "Skipping test of $version \
		    on $myendianness platform."
	} else {
		set o [open PORTABLE.OUT a]
		puts $o "Testing $dbendianness files\
		    on $myendianness platform."
		close $o
		puts "Testing $dbendianness files\
		    on $myendianness platform."

		foreach method [glob -nocomplain $portable_dir/$version/*] {
			regexp \[^\/\]*$ $method method
			set o [open PORTABLE.OUT a]
			puts $o "\nTesting $method files"
			close $o
			puts "\tTesting $method files"

			foreach file [lsort -dictionary \
			    [glob -nocomplain \
			    $portable_dir/$version/$method/*]] {
				regexp (\[^\/\]*)\.tar\.gz$ \
				    $file dummy name

				cleanup $testdir NULL 1
				set curdir [pwd]
				cd $testdir
				set tarfd [open "|tar xf -" w]
				cd $curdir

				catch {exec gunzip -c \
				    "$portable_dir/$version/$method/$name.tar.gz" \
				    >@$tarfd}
				close $tarfd

				set f [open $testdir/$name.tcldump \
				    {RDWR CREAT}]
				close $f

				# We exec a separate tclsh for each
				# separate subtest to keep the
				# testing process from consuming a
				# tremendous amount of memory.
				#
				# Then recover the db.
				if { [file exists \
				    $testdir/$name.db] } {
#puts "found file $testdir/$name.db"
					if { [catch {exec $tclsh_path \
					    << "source \
					    $test_path/test.tcl;\
					    _recover_test $testdir \
					    $version $method $name \
					    $dbendianness" >>& \
					    PORTABLE.OUT } message] } {
						set o [open \
						    PORTABLE.OUT a]
						puts $o "FAIL: $message"
						close $o
					}
				}
			}
		}
	}
}

	set o [open PORTABLE.OUT a]
	puts -nonewline $o "Completed at: "
	puts $o [clock format [clock seconds] -format "%H:%M %D"]
	close $o

	puts -nonewline "Completed at: "
	puts [clock format [clock seconds] -format "%H:%M %D"]

	# Don't provide a return value.
	return
}

proc _recover_test { dir version method name dbendianness } {
	source ./include.tcl
	global errorInfo

	puts "Recover db using opposite endian log: \
	    $version $method $name.db"

	set omethod [convert_method $method]

	# Move the saved database; we'll need to compare it to 
	# the recovered database.
	catch { file rename -force $testdir/$name.db \
	    $testdir/$name.db.init } res
	if { [is_heap $method] == 1 } { 
		file rename -force $testdir/$name.db1 \
		    $testdir/$name.db.init1
		file rename -force $testdir/$name.db2 \
		    $testdir/$name.db.init2
	}


	# Recover.
        set ret [catch {eval {exec} $util_path/db_recover -h $testdir} res]
        if { $ret != 0 } {
                puts "FAIL: db_recover outputted $res"
        }
        error_check_good db_recover $ret 0

	# Compare the original database to the recovered database.
	set dbinit [berkdb_open $omethod $testdir/$name.db.init]
	set db [berkdb_open $omethod $testdir/$name.db]
	db_compare $dbinit $db $testdir/$name.db.init \
	    $testdir/$name.db

	# Verify.
	error_check_good db_verify [verify_dir $testdir "" 0 0 1] 0

}

proc generate_portable_logs { destination_dir } {
	global gen_portable
	global gen_dump
	global portable_dir
	global portable_be
	global portable_method
	global portable_name
	global valid_methods
	global test_names
	global parms
	source ./include.tcl

	if { [string match /* $destination_dir] != 1 } {
		puts "Specify an absolute path for the archived files."
		return
	}

	set portable_dir $destination_dir
	env_cleanup $testdir

	fileremove -f GENERATE.OUT
	set o [open GENERATE.OUT a]

	puts -nonewline $o "Generating files for portability test.  Started at: "
	puts $o [clock format [clock seconds] -format "%H:%M %D"]
	puts $o [berkdb version -string]

	puts -nonewline "Generating files for portability test.  Started at: "
	puts [clock format [clock seconds] -format "%H:%M %D"]
	puts [berkdb version -string]

	close $o

	# Create a file that contains the log version number.
	# If necessary, create the directory to contain the file.
	if { [file exists $destination_dir] == 0 } {
		file mkdir $destination_dir 
	} else {
		puts "$destination_dir already exists, exiting."
		return
	}

	set env [berkdb_env -create -log -home $testdir]
	error_check_good is_valid_env [is_valid_env $env] TRUE

	set lv [open $destination_dir/logversion w]
	puts $lv [get_log_vers $env]
	close $lv

	error_check_good env_close [$env close] 0

	# Generate test databases for each access method and endianness.
	set gen_portable 1
	foreach method $valid_methods {
		set o [open GENERATE.OUT a]
		puts $o "\nGenerating $method files"
		close $o
		puts "\tGenerating $method files"
		set portable_method $method

# Select a variety of tests.  
set test_names(test) "test002 test011 test013 test017 \
    test021 test024 test027 test028"
		foreach test $test_names(test) {
			if { [info exists parms($test)] != 1 } {
				continue
			}

			set o [open GENERATE.OUT a]
			puts $o "\t\tGenerating files for $test"
			close $o
			puts "\t\tGenerating files for $test"

			foreach portable_be { 0 1 } {
				set portable_name $test
				if [catch {exec $tclsh_path \
				    << "source $test_path/test.tcl;\
				    global gen_portable portable_be;\
				    global portable_method portable_name;\
				    global portable_dir;\
				    set gen_portable 1;\
				    set portable_be $portable_be;\
				    set portable_method $portable_method;\
				    set portable_name $portable_name;\
				    set portable_dir $portable_dir;\
				    run_envmethod -$method $test" \
				    >>& GENERATE.OUT} res] {
					puts "FAIL: run_envmethod \
					    $test $method"
				}
				cleanup $testdir NULL 1
			}
		}
	}

	set gen_portable 0
	set o [open GENERATE.OUT a]
	puts -nonewline $o "Completed at: "
	puts $o [clock format [clock seconds] -format "%H:%M %D"]
	puts -nonewline "Completed at: "
	puts [clock format [clock seconds] -format "%H:%M %D"]
	close $o
}

proc save_portable_files { dir } {
	global portable_dir
	global portable_be
	global portable_method
	global portable_name
	global gen_portable
	global gen_dump
	source ./include.tcl

	set vers [berkdb version]
	set maj [lindex $vers 0]
	set min [lindex $vers 1]

	if { [big_endian] } {
		set myendianness be
	} else {
		set myendianness le
	}

	if { $portable_be == 1 } {
		set version_dir "$myendianness-$maj.${min}be"
		set en be
	} else {
		set version_dir "$myendianness-$maj.${min}le"
		set en le
	}

	set dest $portable_dir/$version_dir/$portable_method
	if { [file exists $portable_dir/$version_dir/$portable_method] == 0 } {
		file mkdir $dest
	}

	if { $gen_portable == 1 } {
		# Some tests skip some access methods, so we 
		# only try to save files if there is a datafile
		# file.  
		set dbfiles [glob -nocomplain $dir/*.db]
		if { [llength $dbfiles] > 0 } {
			set logfiles [glob -nocomplain $dir/log.*]
			set dbfile [lindex $dbfiles 0]

			if { $portable_method == "heap" } { 
				append dbfile1 $dbfile "1"
				append dbfile2 $dbfile "2"
			}

			# We arbitrarily name the tar file where we save
			# everything after the first database file we 
			# find.  This works because the database files
			# are almost always named after the test.
			set basename [string range $dbfile \
				    [expr [string length $dir] + 1] end-3]
	
			set cwd [pwd]
			cd $dest
			set dest [pwd]
			cd $cwd
			cd $dir
			if { [catch {
				eval exec tar -cvf $dest/$basename.tar \
				    [glob -nocomplain *.db *.db1 *.db2 \
				    log.* __dbq.$basename-$en.db.*]
				exec gzip --best $dest/$basename.tar
			} res ] } {
				puts "FAIL: tar/gzip of $basename failed\
				    with message $res"
			}
			cd $cwd
		}
	}
}