File: fop001.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 (332 lines) | stat: -rw-r--r-- 8,955 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
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
# See the file LICENSE for redistribution information.
#
# Copyright (c) 2000, 2013 Oracle and/or its affiliates.  All rights reserved.
#
# $Id$
#
# TEST	fop001.tcl
# TEST	Test two file system operations combined in one transaction. 
proc fop001 { method { inmem 0 } { childtxn 0 } args } {
	source ./include.tcl

	set args [convert_args $method $args]
	set omethod [convert_method $method]

	# The variable inmem determines whether the test is being
	# run with regular named databases or named in-memory databases.
	set txntype "transaction"
	if { $inmem == 0 } {
		if { $childtxn == 0 } {
			set tnum "001"
		} else {
			set tnum "009"
			set txntype "child transaction"
			puts "Fop001 with child txns is called fop009."
		}
		set string "regular named databases"
		set operator do_op
	} else {
		if {[is_queueext $method] } {
			puts "Skipping in-memory test for method $method."
			return
		}
		if { $childtxn == 0 } {
			set tnum "007"
			puts "Fop001 with in-memory dbs is called fop007."
		} else {
			set tnum "011"
			set txntype "child transaction"
			puts "Fop001 with in-memory dbs\
			    and child txns is called fop011."
		}
		set string "in-memory named databases"
		set operator do_inmem_op
	}

	puts "\nFop$tnum: ($method)\
	    Two file system ops in one $txntype for $string."

	set exists {a b}
	set noexist {foo bar}
	set open {}
	set cases {}
	set ops {rename remove open open_create open_excl truncate}

	# Set up all sensible two-op cases (op1 succeeds).
	foreach retval { 0 "file exists" "no such file" } {
		foreach op1 {rename remove open open_excl \
		    open_create truncate} {
			foreach op2 $ops {
				append cases " " [create_tests $op1 $op2 \
				    $exists $noexist $open $retval]
			}
		}
	}

	# Set up evil two-op cases (op1 fails).  Omit open_create
	# and truncate from op1 list -- open_create always succeeds
	# and truncate requires a successful open.
	foreach retval { 0 "file exists" "no such file" } {
		foreach op1 { rename remove open open_excl } {
			foreach op2 $ops {
				append cases " " [create_badtests $op1 $op2 \
					$exists $noexist $open $retval]
			}
		}
	}

	# The structure of each case is:
	# {{op1 {names1} result end1} {op2 {names2} result} {remaining}}
	# A result of "0" indicates no error is expected.
	# Otherwise, the result is the expected error message.
	#
	# The "end1" variable indicates whether the first txn
	# ended with an abort or a commit, and is not used
	# in this test.
	#
	# The "remaining" variable lists the files that should 
	# exist at the end of the test case.
	#
	# Comment this loop out to remove the list of cases.
#	set i 1
#	foreach case $cases {
#		puts "\tFop$tnum:$i: $case"
#		incr i
#	}

	set testid 0

	# Run all the cases
	foreach case $cases {
		env_cleanup $testdir
		incr testid

		# Extract elements of the case
		set op1 [lindex [lindex $case 0] 0]
		set names1 [lindex [lindex $case 0] 1]
		set res1 [lindex [lindex $case 0] 2]

		set op2 [lindex [lindex $case 1] 0]
		set names2 [lindex [lindex $case 1] 1]
		set res2 [lindex [lindex $case 1] 2]
		set remaining [lindex [lindex $case 1] 3]

		# Use the list of remaining files to derive
		# the list of files that should be gone.
		set allnames { a b foo bar }
		set gone {}
		foreach f $allnames {
			set idx [lsearch -exact $remaining $f]
			if { $idx == -1 } {
				lappend gone $f
			}
		}

		puts -nonewline "\tFop$tnum.$testid: $op1 ($names1), " 
		puts "then $op2 ($names2)."

		# The variable 'when' describes when to resolve a txn -- 
		# before or after closing any open databases. 
		foreach when { before after } {

			# Create transactional environment.
			set env [berkdb_env -create -home $testdir -txn nosync]
			error_check_good is_valid_env [is_valid_env $env] TRUE
	
			# Create two databases, dba and dbb.
			if { $inmem == 0 } {
				set dba [eval {berkdb_open -create} $omethod \
				    $args -env $env -auto_commit a]
			} else {
				set dba [eval {berkdb_open -create} $omethod \
				    $args -env $env -auto_commit { "" a }]
			}
			error_check_good dba_open [is_valid_db $dba] TRUE
			error_check_good dba_put [$dba put 1 a] 0
			error_check_good dba_close [$dba close] 0
	
			if { $inmem == 0 } {
				set dbb [eval {berkdb_open -create} $omethod \
				    $args -env $env -auto_commit b]
			} else {
				set dbb [eval {berkdb_open -create} $omethod \
				    $args -env $env -auto_commit { "" b }]
			}
			error_check_good dbb_open [is_valid_db $dbb] TRUE
			error_check_good dbb_put [$dbb put 1 b] 0
			error_check_good dbb_close [$dbb close] 0
	
			# The variable 'end' describes how to resolve the txn.
			# We run the 'abort' first because that leaves the env
			# properly set up for the 'commit' test.
			foreach end {abort commit} {
	
				# Start transaction
				set parent [$env txn]
				set parent_end "commit"
				set msg ""
				if { $childtxn } {
					set child [$env txn -parent $parent]
					set txn $child
					set msg "(committing parent)"
					if { [berkdb random_int 0 1] == 0 } {
						set parent_end "abort"
						set msg "(aborting parent)"
					}
				} else {
					set txn $parent
				}

				puts "\t\tFop$tnum.$testid:\
				    $end $when closing database. $msg"
	
				# Execute and check operation 1
				set result1 [$operator \
				    $omethod $op1 $names1 $txn $env $args]
				if { $res1 == 0 } {
					error_check_good \
					    op1_should_succeed $result1 $res1
				} else {
					set error [extract_error $result1]
					error_check_good \
					    op1_wrong_failure $error $res1
				}
	
				# Execute and check operation 2
				set result2 [$operator \
				    $omethod $op2 $names2 $txn $env $args]
				if { $res2 == 0 } {
					error_check_good \
					    op2_should_succeed $result2 $res2
				} else {
					set error [extract_error $result2]
					error_check_good \
					    op2_wrong_failure $error $res2
				}
	
				if { $when == "before" } {
					error_check_good txn_$end [$txn $end] 0
					if { $childtxn } {
						error_check_good parent_end \
						    [$parent $parent_end] 0 
					}
		
					# If the txn was aborted, we still
					# have the original two databases.
					# Otherwise check for the expected
					# remaining files.
					if { $end == "abort" ||\
					    $parent_end == "abort" } {
						error_check_good db_exists \
						    [database_exists \
						    $inmem $testdir a] 1
						error_check_good db_exists \
						    [database_exists \
						    $inmem $testdir b] 1
					} else {
						foreach db $remaining {
							error_check_good db_exists \
							    [database_exists \
							    $inmem $testdir $db] 1
						}
						foreach db $gone {
							error_check_good db_gone \
							    [database_exists \
							    $inmem $testdir $db] 0
						}
					}

					close_db_handles 
				} else {
					close_db_handles
					error_check_good txn_$end [$txn $end] 0
					if { $childtxn } {
						error_check_good resolve_parent \
						    [$parent $parent_end] 0 
					}
	
					if { $end == "abort" || $parent_end == "abort" } {
						error_check_good db_exists \
						    [database_exists \
						    $inmem $testdir a] 1
						error_check_good db_exists \
						    [database_exists \
						    $inmem $testdir b] 1
					} else {
						foreach db $remaining {
							error_check_good db_exists \
							    [database_exists \
							    $inmem $testdir $db] 1
						}
						foreach db $gone {
							error_check_good db_gone \
							    [database_exists \
							    $inmem $testdir $db] 0
						}

					}
				}		
			}
	
			# Clean up for next case
			error_check_good env_close [$env close] 0
			error_check_good envremove \
			    [berkdb envremove -home $testdir] 0
			env_cleanup $testdir
		}
	}
}

proc database_exists { inmem testdir name } {
	if { $inmem == 1 } {
		return [inmem_exists $testdir $name]
	} else {
		return [file exists $testdir/$name]
	}	

}

# This is a real hack.  We need to figure out if an in-memory named
# file exists.  In a perfect world we could use mpool stat.  Unfortunately,
# mpool_stat returns files that have deadfile set and we need to not consider
# those files to be meaningful.  So, we are parsing the output of db_stat -MA
# (I told you this was a hack)  If we ever change the output, this is going
# to break big time.  Here is what we assume:
# A file is represented by: File #N name
# The last field printed for a file is Flags
# If the file is dead, deadfile will show up in the flags
proc inmem_exists { dir filename } {
	source ./include.tcl
	set infile 0
	set islive 0
	set name ""
	set s [exec $util_path/db_stat -MA -h $dir]
	foreach i $s {
		if { $i == "File" } {
			set infile 1
			set islive 1
			set name ""
		} elseif { $i == "Flags" } {
			set infile 0
			if { $name != "" && $islive } {
				return 1
			}
		} elseif { $infile != 0 } {
			incr infile
		}

		if { $islive } {
			if { $i == "deadfile," || $i == "deadfile" } {
				set islive 0
			}
		}

		if { $infile == 3 } {
			if { $i == $filename } {
				set name $filename
			}
		}
	}
	return 0
}