Import changeset

1 files changed, 130 insertions, 0 deletions

diff --git a/bdb/test/logtrack.tcl b/bdb/test/logtrack.tcl
new file mode 100644
index 00000000000..cea4912e627
--- /dev/null
+++ b/bdb/test/logtrack.tcl
@@ -0,0 +1,130 @@
+# See the file LICENSE for redistribution information
+#
+# Copyright (c) 2000
+#       Sleepycat Software.  All rights reserved.
+#
+#       $Id: logtrack.tcl,v 11.6 2000/10/27 15:30:39 krinsky 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
+
+	set seendb [berkdb_open $ltsname]
+	error_check_good seendb_open [is_valid_db $seendb] TRUE
+
+	file delete -force $tmpname
+	set ret [catch {exec $util_path/db_printlog -N \
+	    -h "$dirname" > $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 } {
+		regexp {\[[^\]]*\]\[[^\]]*\]([^\:]*)\:} $record whl name
+		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/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 } {
+			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
+}