blob: ad6b480b4e3252773820b46dbf1f3b5dc711e60b (
plain)
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
|
# See the file LICENSE for redistribution information
#
# Copyright (c) 2000-2002
# Sleepycat Software. All rights reserved.
#
# $Id: logtrack.tcl,v 11.11 2002/09/03 16:44:37 sue Exp $
#
# logtrack.tcl: A collection of routines, formerly implemented in Perl
# as log.pl, to track which log record types the test suite hits.
set ltsname "logtrack_seen.db"
set ltlist $test_path/logtrack.list
set tmpname "logtrack_tmp"
proc logtrack_clean { } {
global ltsname
file delete -force $ltsname
return
}
proc logtrack_init { } {
global ltsname
logtrack_clean
# Create an empty tracking database.
[berkdb_open -create -truncate -btree $ltsname] close
return
}
# Dump the logs for directory dirname and record which log
# records were seen.
proc logtrack_read { dirname } {
global ltsname tmpname util_path
global encrypt passwd
set seendb [berkdb_open $ltsname]
error_check_good seendb_open [is_valid_db $seendb] TRUE
file delete -force $tmpname
set pargs " -N -h $dirname "
if { $encrypt > 0 } {
append pargs " -P $passwd "
}
set ret [catch {eval exec $util_path/db_printlog $pargs > $tmpname} res]
error_check_good printlog $ret 0
error_check_good tmpfile_exists [file exists $tmpname] 1
set f [open $tmpname r]
while { [gets $f record] >= 0 } {
set r [regexp {\[[^\]]*\]\[[^\]]*\]([^\:]*)\:} $record whl name]
if { $r == 1 } {
error_check_good seendb_put [$seendb put $name ""] 0
}
}
close $f
file delete -force $tmpname
error_check_good seendb_close [$seendb close] 0
}
# Print the log record types that were seen but should not have been
# seen and the log record types that were not seen but should have been seen.
proc logtrack_summary { } {
global ltsname ltlist testdir
set seendb [berkdb_open $ltsname]
error_check_good seendb_open [is_valid_db $seendb] TRUE
set existdb [berkdb_open -create -btree]
error_check_good existdb_open [is_valid_db $existdb] TRUE
set deprecdb [berkdb_open -create -btree]
error_check_good deprecdb_open [is_valid_db $deprecdb] TRUE
error_check_good ltlist_exists [file exists $ltlist] 1
set f [open $ltlist r]
set pref ""
while { [gets $f line] >= 0 } {
# Get the keyword, the first thing on the line:
# BEGIN/DEPRECATED/IGNORED/PREFIX
set keyword [lindex $line 0]
if { [string compare $keyword PREFIX] == 0 } {
# New prefix.
set pref [lindex $line 1]
} elseif { [string compare $keyword BEGIN] == 0 } {
# A log type we care about; put it on our list.
# Skip noop and debug.
if { [string compare [lindex $line 1] noop] == 0 } {
continue
}
if { [string compare [lindex $line 1] debug] == 0 } {
continue
}
error_check_good exist_put [$existdb put \
${pref}_[lindex $line 1] ""] 0
} elseif { [string compare $keyword DEPRECATED] == 0 ||
[string compare $keyword IGNORED] == 0 } {
error_check_good deprec_put [$deprecdb put \
${pref}_[lindex $line 1] ""] 0
}
}
error_check_good exist_curs \
[is_valid_cursor [set ec [$existdb cursor]] $existdb] TRUE
while { [llength [set dbt [$ec get -next]]] != 0 } {
set rec [lindex [lindex $dbt 0] 0]
if { [$seendb count $rec] == 0 } {
puts "FAIL: log record type $rec not seen"
}
}
error_check_good exist_curs_close [$ec close] 0
error_check_good seen_curs \
[is_valid_cursor [set sc [$existdb cursor]] $existdb] TRUE
while { [llength [set dbt [$sc get -next]]] != 0 } {
set rec [lindex [lindex $dbt 0] 0]
if { [$existdb count $rec] == 0 } {
if { [$deprecdb count $rec] == 0 } {
puts "FAIL: unknown log record type $rec seen"
} else {
puts "FAIL: deprecated log record type $rec seen"
}
}
}
error_check_good seen_curs_close [$sc close] 0
error_check_good seendb_close [$seendb close] 0
error_check_good existdb_close [$existdb close] 0
error_check_good deprecdb_close [$deprecdb close] 0
logtrack_clean
}
|
