? .aku
? log.diff.2
? ChangeLog.orig.0
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/ChangeLog,v
retrieving revision 1.49
diff -u -r1.49 ChangeLog
--- ChangeLog	2000/11/03 06:43:41	1.49
+++ ChangeLog	2001/03/21 00:15:03
@@ -1,3 +1,30 @@
+2001-03-21  Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+	* Makefile.in: Added module 'log'.
+
+2001-03-20  Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+	* all.tcl: [Bug #410100, Patch #410105]
+	  Squashed a subtle bug with package management for the
+	  tests. Changes: all.tcl now adds the module path to the
+	  auto_path (the tested modules did it themselves before) and also
+	  moved the setting of the auto_path in the slave before the first
+	  'package require'. Why ? Assume the old code, an installed
+	  fileutil 1.0 and a new fileutil 1.1 under development. The
+	  initialization of the tests scans the package directories and
+	  finds fileutil 1.0. The module then adds itself to the auto_path
+	  and then requires fileutil (without version). Now fileutil 1.0
+	  is found by the pkg management, it is acceptable according to
+	  the rules of require and thus used. The new version is not
+	  considered at all, as changing the auto_path does *not* enforce
+	  a rescan of package directories. It is possible to solve the
+	  problem by having the modules require themselves and request a
+	  specific version (1.1 in this case). But this would mean that in
+	  each module we have (at least) one more file containing the
+	  version number (all test files!) and we have to maintain this
+	  for every module. The change here however solves the problem
+	  without touching the modules at all.
+
 2000-11-02  Brent Welch <welch@ajubasolutions.com>
 
         * configure.in: Bumped version number to 0.8
Index: Makefile.in
===================================================================
RCS file: /cvsroot/tcllib/tcllib/Makefile.in,v
retrieving revision 1.40
diff -u -r1.40 Makefile.in
--- Makefile.in	2000/11/02 19:26:55	1.40
+++ Makefile.in	2001/03/21 00:15:05
@@ -7,6 +7,7 @@
 #	replaced in the actual Makefile.
 #
 # Copyright (c) 1999-2000 Ajuba Solutions
+# Copyright (c) 2001      ActiveState Tool Corp.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -66,6 +67,9 @@
 # Counters and statistics
 COUNTER=counter
 
+# Logging facility
+LOGGER=log
+
 MODULES= \
 	$(BASE64)	\
 	$(CMDLINE)	\
@@ -83,7 +87,8 @@
 	$(POP3)		\
 	$(PROFILER)	\
 	$(TEXTUTIL)	\
-	$(URI)
+	$(URI)		\
+	$(LOGGER)
 
 #========================================================================
 # Nothing of the variables below this line need to be changed.  Please
Index: modules/log/ChangeLog
===================================================================
RCS file: ChangeLog
diff -N ChangeLog
--- /dev/null	Mon Dec 11 17:26:27 2000
+++ ChangeLog	Tue Mar 20 16:15:07 2001
@@ -0,0 +1,3 @@
+2001-03-20  Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+	* New module 'log', a logging facility.
Index: modules/log/log.n
===================================================================
RCS file: log.n
diff -N log.n
Index: modules/log/log.tcl
===================================================================
RCS file: log.tcl
diff -N log.tcl
--- /dev/null	Mon Dec 11 17:26:27 2000
+++ log.tcl	Tue Mar 20 16:15:09 2001
@@ -0,0 +1,705 @@
+# log.tcl --
+#
+#	Tcl implementation of a general logging facility
+#	(Reaped from Pool_Base and modified to fit into tcllib)
+#
+# Copyright (c) 2001 by ActiveState Tool Corp.
+# See the file license.terms.
+
+package provide log 1.0
+
+namespace eval ::log {
+    namespace export *
+
+    # The known log-levels.
+
+    variable levels [list \
+	    emergency \
+	    alert \
+	    critical \
+	    error \
+	    warning \
+	    notice \
+	    info \
+	    debug]
+
+    # Array mapping from all unique prefixes for log levels to their
+    # corresponding long form.
+
+    # *future* Use a procedure from 'textutil' to calculate the
+    #          prefixes and to fill the map.
+
+    variable  levelMap
+    array set levelMap {
+	a		alert
+	al		alert
+	ale		alert
+	aler		alert
+	alert		alert
+	c		critical
+	cr		critical
+	cri		critical
+	crit		critical
+	criti		critical
+	critic		critical
+	critica		critical
+	critical	critical
+	d		debug
+	de		debug
+	deb		debug
+	debu		debug
+	debug		debug
+	em		emergency
+	eme		emergency
+	emer		emergency
+	emerg		emergency
+	emerge		emergency
+	emergen		emergency
+	emergenc	emergency
+	emergency	emergency
+	er		error
+	err		error
+	erro		error
+	error		error
+	i		info
+	in		info
+	inf		info
+	info		info
+	n		notice
+	no		notice
+	not		notice
+	noti		notice
+	notic		notice
+	notice		notice
+	w		warning
+	wa		warning
+	war		warning
+	warn		warning
+	warni		warning
+	warnin		warning
+	warning		warning
+    }
+
+    # Map from log-levels to the commands to execute when a message
+    # with that level arrives in the system. The standard command for
+    # all levels is '::log::Puts' which writes the message to either
+    # stdout or stderr, depending on the level. The decision about the
+    # channel is stored in another map and modifiable by the user of
+    # the package.
+
+    variable  cmdMap
+    array set cmdMap {}
+
+    variable lv
+    foreach  lv $levels {set cmdMap($lv) ::log::Puts}
+    unset    lv
+
+    # Map from log-levels to the channels ::log::Puts shall write
+    # messages with that level to. The map can be queried and changed
+    # by the user.
+
+    variable  channelMap
+    array set channelMap {
+	emergency  stderr
+	alert      stderr
+	critical   stderr
+	error      stderr
+	warning    stdout
+	notice     stdout
+	info       stdout
+	debug      stdout
+    }
+
+    # Graphical user interfaces may want to colorize messages based
+    # upon their level. The following array stores a map from levels
+    # to colors. The map can be queried and changed by the user.
+
+    variable  colorMap
+    array set colorMap {
+	emergency red
+	alert     red
+	critical  red
+	error     red
+	warning   yellow
+	notice    seagreen
+	info      {}
+	debug     lightsteelblue
+    }
+
+    # To allow an easy comparison of the relative importance of a
+    # level the following array maps from levels to a numerical
+    # priority. The higher the number the more important the
+    # level. The user cannot change this map (for now). This package
+    # uses the priorities to allow the user to supress messages based
+    # upon their levels.
+
+    variable  priorityMap
+    array set priorityMap {
+	emergency 7
+	alert     6
+	critical  5
+	error     4
+	warning   3
+	notice    2
+	info      1
+	debug     0
+    }
+
+    # The following array is internal and holds the information about
+    # which levels are suppressed, i.e. may not be written.
+    #
+    # 0 - messages with with level are written out.
+    # 1 - messages with this level are suppressed.
+
+    variable  suppressed
+    array set suppressed {
+	emergency 0
+	alert     0
+	critical  0
+	error     0
+	warning   0
+	notice    0
+	info      0
+	debug     0
+    }
+
+    # Internal static information. Map from levels to a string of
+    # spaces. The number of spaces in each string is just enough to
+    # make all level names together with their string of the same
+    # length.
+
+    variable  fill
+    array set fill {
+	emergency ""	alert "    "	critical " "	error "    "
+	warning "  "	notice "   "	info "     "	debug "    "
+    }
+}
+
+
+# log::levels --
+#
+#	Retrieves the names of all known levels.
+#
+# Arguments:
+#	None.
+#
+# Side Effects:
+#	None.
+#
+# Results:
+#	A list containing the names of all known levels,
+#	alphabetically sorted.
+
+proc ::log::levels {} {
+    variable levels
+    return [lsort $levels]
+}
+
+# log::lv2longform --
+#
+#	Converts any unique abbreviation of a level name to the full
+#	level name.
+#
+# Arguments:
+#	level	The prefix of a level name to convert.
+#
+# Side Effects:
+#	None.
+#
+# Results:
+#	Returns the full name to the specified abbreviation or an
+#	error.
+
+proc ::log::lv2longform {level} {
+    variable levelMap
+
+    if {[info exists levelMap($level)]} {
+	return $levelMap($level)
+    }
+
+    return -code error "\"$level\" is no unique abbreviation of a level name"
+}
+
+# log::lv2color --
+#
+#	Converts any level name including unique abbreviations to the
+#	corresponding color.
+#
+# Arguments:
+#	level	The level to convert into a color.
+#
+# Side Effects:
+#	None.
+#
+# Results:
+#	The name of a color or an error.
+
+proc ::log::lv2color {level} {
+    variable colorMap
+    set level [lv2longform $level]
+    return $colorMap($level)
+}
+
+# log::lv2priority --
+#
+#	Converts any level name including unique abbreviations to the
+#	corresponding priority.
+#
+# Arguments:
+#	level	The level to convert into a priority.
+#
+# Side Effects:
+#	None.
+#
+# Results:
+#	The numerical priority of the level or an error.
+
+proc ::log::lv2priority {level} {
+    variable priorityMap
+    set level [lv2longform $level]
+    return $priorityMap($level)
+}
+
+# log::lv2cmd --
+#
+#	Converts any level name including unique abbreviations to the
+#	command prefix used to write messages with that level.
+#
+# Arguments:
+#	level	The level to convert into a command prefix.
+#
+# Side Effects:
+#	None.
+#
+# Results:
+#	A string containing a command prefix or an error.
+
+proc ::log::lv2cmd {level} {
+    variable cmdMap
+    set level [lv2longform $level]
+    return $cmdMap($level)
+}
+
+# log::lv2channel --
+#
+#	Converts any level name including unique abbreviations to the
+#	channel used by ::log::Puts to write messages with that level.
+#
+# Arguments:
+#	level	The level to convert into a channel.
+#
+# Side Effects:
+#	None.
+#
+# Results:
+#	A string containing a channel handle or an error.
+
+proc ::log::lv2channel {level} {
+    variable channelMap
+    set level [lv2longform $level]
+    return $channelMap($level)
+}
+
+# log::lvCompare --
+#
+#	Compares two levels (including unique abbreviations) with
+#	respect to their priority. This command can be used by the
+#	-command option of lsort.
+#
+# Arguments:
+#	level1	The first of the levels to compare.
+#	level2	The second of the levels to compare.
+#
+# Side Effects:
+#	None.
+#
+# Results:
+#	One of -1, 0 or 1 or an error. A result of -1 signals that
+#	level1 is of less priority than level2. 0 signals that both
+#	levels have the same priority. 1 signals that level1 has
+#	higher priority than level2.
+
+proc ::log::lvCompare {level1 level2} {
+    variable priorityMap
+
+    set level1 $priorityMap([lv2longform $level1])
+    set level2 $priorityMap([lv2longform $level2])
+
+    if {$level1 < $level2} {
+	return -1
+    } elseif {$level1 > $level2} {
+	return 1
+    } else {
+	return 0
+    }
+}
+
+# log::lvSuppress --
+#
+#	(Un)suppresses the output of messages having the specified
+#	level. Unique abbreviations for the level are allowed here
+#	too.
+#
+# Arguments:
+#	level		The name of the level to suppress or
+#			unsuppress. Unique abbreviations are allowed
+#			too.
+#	suppress	Boolean flag. Optional. Defaults to the value
+#			1, which means to suppress the level. The
+#			value 0 on the other hand unsuppresses the
+#			level.
+#
+# Side Effects:
+#	See above.
+#
+# Results:
+#	None.
+
+proc ::log::lvSuppress {level {suppress 1}} {
+    variable suppressed
+    set level [lv2longform $level]
+
+    switch -exact -- $suppress {
+	0 - 1 {} default {
+	    return -code error "\"$suppress\" is not a member of \{0, 1\}"
+	}
+    }
+
+    set suppressed($level) $suppress
+    return
+}
+
+# log::lvSuppressLE --
+#
+#	(Un)suppresses the output of messages having the specified
+#	level or one of lesser priority. Unique abbreviations for the
+#	level are allowed here too.
+#
+# Arguments:
+#	level		The name of the level to suppress or
+#			unsuppress. Unique abbreviations are allowed
+#			too.
+#	suppress	Boolean flag. Optional. Defaults to the value
+#			1, which means to suppress the specified
+#			levels. The value 0 on the other hand
+#			unsuppresses the levels.
+#
+# Side Effects:
+#	See above.
+#
+# Results:
+#	None.
+
+proc ::log::lvSuppressLE {level {suppress 1}} {
+    variable suppressed
+    variable levels
+    variable priorityMap
+
+    set level [lv2longform $level]
+
+    switch -exact -- $suppress {
+	0 - 1 {} default {
+	    return -code error "\"$suppress\" is not a member of \{0, 1\}"
+	}
+    }
+
+    set prio  [lv2priority $level]
+
+    foreach l $levels {
+	if {$priorityMap($l) <= $prio} {
+	    set suppressed($l) $suppress
+	}
+    }
+    return
+}
+
+# log::lvIsSuppressed --
+#
+#	Asks the package wether the specified level is currently
+#	suppressed. Unique abbreviations of level names are allowed.
+#
+# Arguments:
+#	level	The level to query.
+#
+# Side Effects:
+#	None.
+#
+# Results:
+#	None.
+
+proc ::log::lvIsSuppressed {level} {
+    variable suppressed
+    set level [lv2longform $level]
+    return $suppressed($level)
+}
+
+# log::lvCmd --
+#
+#	Defines for the specified level with which command to write
+#	the messages having this level. Unique abbreviations of level
+#	names are allowed. The command is actually a command prefix
+#	and this facility will append 2 arguments before calling it,
+#	the level of the message and the message itself, in this
+#	order.
+#
+# Arguments:
+#	level	The level the command prefix is for.
+#	cmd	The command prefix to use for the specified level.
+#
+# Side Effects:
+#	See above.
+#
+# Results:
+#	None.
+
+proc ::log::lvCmd {level cmd} {
+    variable cmdMap
+    set level [lv2longform $level]
+    set cmdMap($level) $cmd
+    return
+}
+
+# log::lvCmdForall --
+#
+#	Defines for all known levels with which command to write the
+#	messages having this level. The command is actually a command
+#	prefix and this facility will append 2 arguments before
+#	calling it, the level of the message and the message itself,
+#	in this order.
+#
+# Arguments:
+#	cmd	The command prefix to use for all levels.
+#
+# Side Effects:
+#	See above.
+#
+# Results:
+#	None.
+
+proc ::log::lvCmdForall {cmd} {
+    variable cmdMap
+    variable levels
+
+    foreach l $levels {
+	set cmdMap($l) $cmd
+    }
+    return
+}
+
+# log::lvChannel --
+#
+#	Defines for the specified level into which channel ::log::Puts
+#	(the standard command) shall write the messages having this
+#	level. Unique abbreviations of level names are allowed. The
+#	command is actually a command prefix and this facility will
+#	append 2 arguments before calling it, the level of the message
+#	and the message itself, in this order.
+#
+# Arguments:
+#	level	The level the channel is for.
+#	chan	The channel to use for the specified level.
+#
+# Side Effects:
+#	See above.
+#
+# Results:
+#	None.
+
+proc ::log::lvChannel {level chan} {
+    variable channelMap
+    set level [lv2longform $level]
+    set channelMap($level) $chan
+    return
+}
+
+# log::lvChannelForall --
+#
+#	Defines for all known levels with which which channel
+#	::log::Puts (the standard command) shall write the messages
+#	having this level. The command is actually a command prefix
+#	and this facility will append 2 arguments before calling it,
+#	the level of the message and the message itself, in this
+#	order.
+#
+# Arguments:
+#	chan	The channel to use for all levels.
+#
+# Side Effects:
+#	See above.
+#
+# Results:
+#	None.
+
+proc ::log::lvChannelForall {chan} {
+    variable channelMap
+    variable levels
+
+    foreach l $levels {
+	set channelMap($l) $chan
+    }
+    return
+}
+
+# log::lvColor --
+#
+#	Defines for the specified level the color to return for it in
+#	a call to ::log::lv2color. Unique abbreviations of level names
+#	are allowed.
+#
+# Arguments:
+#	level	The level the color is for.
+#	color	The color to use for the specified level.
+#
+# Side Effects:
+#	See above.
+#
+# Results:
+#	None.
+
+proc ::log::lvColor {level color} {
+    variable colorMap
+    set level [lv2longform $level]
+    set colorMap($level) $color
+    return
+}
+
+# log::lvColorForall --
+#
+#	Defines for all known levels the color to return for it in a
+#	call to ::log::lv2color. Unique abbreviations of level names
+#	are allowed.
+#
+# Arguments:
+#	color	The color to use for all levels.
+#
+# Side Effects:
+#	See above.
+#
+# Results:
+#	None.
+
+proc ::log::lvColorForall {color} {
+    variable colorMap
+    variable levels
+
+    foreach l $levels {
+	set colorMap($l) $color
+    }
+    return
+}
+
+# log::log --
+#
+#	Log a message according to the specifications for commands,
+#	channels and suppression. In other words: The command will do
+#	nothing if the specified level is suppressed. If it is not
+#	suppressed the actual logging is delegated to the specified
+#	command. If there is no command specified for the level the
+#	message won't be logged. The standard command ::log::Puts will
+#	write the message to the channel specified for the given
+#	level. If no channel is specified for the level the message
+#	won't be logged. Unique abbreviations of level names are
+#	allowed. Errors in the actual logging command are *not*
+#	catched, but propagated to the caller, as they may indicate
+#	misconfigurations of the log facility or errors in the callers
+#	code itself.
+#
+# Arguments:
+#	level	The level of the message.
+#	text	The message to log.
+#
+# Side Effects:
+#	See above.
+#
+# Results:
+#	None.
+
+proc ::log::log {level text} {
+    variable cmdMap
+
+    if {[lvIsSuppressed $level]} {
+	# Ignore messages for suppressed levels.
+	return
+    }
+
+    set level [lv2longform $level]
+
+    set cmd $cmdMap($level)
+    if {$cmd == {}} {
+	# Ignore messages for levels without a command
+	return
+    }
+
+    # Delegate actual logging to the command
+
+    lappend cmd $level $text
+    eval $cmd
+    return
+}
+
+# log::logMsg --
+#
+#	Convenience wrapper around ::log::log. Equivalent to
+#	'::log::log info text'.
+#
+# Arguments:
+#	text	The message to log.
+#
+# Side Effects:
+#	See ::log::log.
+#
+# Results:
+#	None.
+
+proc ::log::logMsg {text} {
+    log info $text
+}
+
+# log::logError --
+#
+#	Convenience wrapper around ::log::log. Equivalent to
+#	'::log::log error text'.
+#
+# Arguments:
+#	text	The message to log.
+#
+# Side Effects:
+#	See ::log::log.
+#
+# Results:
+#	None.
+
+proc ::log::logError {text} {
+    log error $text
+}
+
+
+# log::Puts --
+#
+#	Standard log command, writing messages and levels to
+#	user-specified channels. Assumes that a supression checks were
+#	done by the caller. Expects full level names, *no* abbreviations.
+#
+# Arguments:
+#	level	The level of the message. 
+#	text	The message to log.
+#
+# Side Effects:
+#	Writes into channels.
+#
+# Results:
+#	None.
+
+proc ::log::Puts {level text} {
+    variable channelMap
+    variable fill
+
+    set chan $channelMap($level)
+    if {$chan == {}} {
+	# Ignore levels without channel.
+	return
+    }
+
+    puts $chan "$level$fill($level) $text"
+    return
+}
Index: modules/log/log.test
===================================================================
RCS file: log.test
diff -N log.test
--- /dev/null	Mon Dec 11 17:26:27 2000
+++ log.test	Tue Mar 20 16:15:09 2001
@@ -0,0 +1,355 @@
+# -*- tcl -*-
+# Tests for the log facility
+#
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# Copyright (c) 2001 by ActiveState Tool Corp.
+# All rights reserved.
+#
+# RCS: @(#) $Id: fileutil.test,v 1.3 2000/05/31 00:00:00 ericm Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import ::tcltest::*
+}
+
+if { [lsearch $auto_path [file dirname [info script]]] == -1 } {
+    set auto_path [linsert $auto_path 0 [file dirname [info script]]]
+}
+
+package require log
+puts "log [package present log]"
+
+test log-1.0 {levels} {
+    ::log::levels
+} {alert critical debug emergency error info notice warning}
+
+foreach {abbrev long} {
+	a		alert            d               debug
+	al		alert            de              debug
+	ale		alert            deb             debug
+	aler		alert            debu            debug
+	alert		alert            debug           debug
+	c		critical         em              emergency
+	cr		critical         eme             emergency
+	cri		critical         emer            emergency
+	crit		critical         emerg           emergency
+	criti		critical         emerge          emergency
+	critic		critical         emergen         emergency
+	critica		critical         emergenc        emergency
+	critical	critical         emergency       emergency
+	er		error            i               info
+	err		error            in              info
+	erro		error            inf             info
+	error		error            info            info
+	n		notice           w               warning
+	no		notice           wa              warning
+	not		notice           war             warning
+	noti		notice           warn            warning
+	notic		notice           warni           warning
+	notice		notice           warnin          warning
+				         warning         warning
+} {
+    test log-2.0.$abbrev {level abbreviations} {
+	::log::lv2longform $abbrev
+    } $long
+}
+
+test log-2.1 {abbreviation error} {
+    if {![catch {::log::lv2longform e} msg]} {
+	error "e is an unique abbreviation of a level name"
+    }
+    set msg
+} {"e" is no unique abbreviation of a level name}
+
+foreach {level color} {
+	emergency red        warning   yellow
+	alert     red        notice    seagreen
+	critical  red        info      {}
+	error     red        debug     lightsteelblue
+} {
+    test log-3.0.$level {color conversion} {
+	::log::lv2color $level
+    } $color
+}
+
+test log-3.1 {color conversion error} {
+    if {![catch {::log::lv2color foo} msg]} {
+	error "foo is an unique abbreviation of a level name"
+    }
+    set msg
+} {"foo" is no unique abbreviation of a level name}
+
+foreach {level priority} {
+	emergency 7        warning   3
+	alert     6        notice    2
+	critical  5        info      1
+	error     4        debug     0
+} {
+    test log-4.0.$level {priority conversion} {
+	::log::lv2priority $level
+    } $priority
+}
+
+test log-4.1 {priority conversion error} {
+    if {![catch {::log::lv2priority foo} msg]} {
+	error "foo is an unique abbreviation of a level name"
+    }
+    set msg
+} {"foo" is no unique abbreviation of a level name}
+
+foreach level {alert critical debug error emergency info notice warning} {
+    test log-5.0.$level {cmd retrieval} {
+	::log::lv2cmd $level
+    } ::log::Puts
+}
+
+test log-5.1 {cmd error} {
+    if {![catch {::log::lv2cmd foo} msg]} {
+	error "foo is an unique abbreviation of a level name"
+    }
+    set msg
+} {"foo" is no unique abbreviation of a level name}
+
+foreach {level chan} {
+	emergency  stderr        warning    stdout
+	alert      stderr        notice     stdout
+	critical   stderr        info       stdout
+	error      stderr        debug      stdout
+} {
+    test log-6.0.$level {channel retrieval} {
+	::log::lv2channel $level
+    } $chan
+}
+
+test log-6.1 {channel error} {
+    if {![catch {::log::lv2channel foo} msg]} {
+	error "foo is an unique abbreviation of a level name"
+    }
+    set msg
+} {"foo" is no unique abbreviation of a level name}
+
+foreach level {alert critical debug error emergency info notice warning} {
+    test log-7.0.$level {query suppression state} {
+	::log::lvIsSuppressed $level
+    } 0
+}
+
+test log-7.1 {error when querying suppression state} {
+    if {![catch {::log::lv2cmd foo} msg]} {
+	error "foo is an unique abbreviation of a level name"
+    }
+    set msg
+} {"foo" is no unique abbreviation of a level name}
+
+
+foreach {la lb res} {
+    emergency emergency 0    alert emergency -1    critical emergency -1    error emergency -1
+    emergency alert     1    alert alert      0    critical alert     -1    error alert     -1
+    emergency critical  1    alert critical   1    critical critical   0    error critical  -1
+    emergency error     1    alert error      1    critical error      1    error error      0
+    emergency warning   1    alert warning    1    critical warning    1    error warning    1
+    emergency notice    1    alert notice     1    critical notice     1    error notice     1
+    emergency info      1    alert info       1    critical info       1    error info       1
+    emergency debug     1    alert debug      1    critical debug      1    error debug      1
+
+    warning emergency -1    notice emergency -1    info emergency -1    debug emergency -1
+    warning alert     -1    notice alert     -1    info alert     -1    debug alert     -1
+    warning critical  -1    notice critical  -1    info critical  -1    debug critical  -1
+    warning error     -1    notice error     -1    info error     -1    debug error     -1
+    warning warning    0    notice warning   -1    info warning   -1    debug warning   -1
+    warning notice     1    notice notice     0    info notice    -1    debug notice    -1
+    warning info       1    notice info       1    info info       0    debug info      -1
+    warning debug      1    notice debug      1    info debug      1    debug debug      0
+} {
+    test log-8.0.$la.$lb {level priority comparisons} {
+	list [::log::lvCompare $la $lb] $la $lb
+    } [list $res $la $lb]
+}
+
+test log-8.1 {comparison errors} {
+    if {![catch {::log::lvCompare foo error} msg]} {
+	error "foo is an unique abbreviation of a level name"
+    }
+    set msg
+} {"foo" is no unique abbreviation of a level name}
+
+test log-8.2 {comparison errors} {
+    if {![catch {::log::lvCompare error foo} msg]} {
+	error "foo is an unique abbreviation of a level name"
+    }
+    set msg
+} {"foo" is no unique abbreviation of a level name}
+
+
+foreach level {alert critical debug error emergency info notice warning} {
+    test log-9.0.$level {redefining colors} {
+	set old [::log::lv2color $level]
+	::log::lvColor $level foo
+	set new [::log::lv2color $level]
+	::log::lvColor $level $old
+	set new
+    } foo
+}
+
+test log-9.1 {redefining colors} {
+    ::log::lvColorForall fox
+    set res [list]
+    foreach level [::log::levels] {
+	lappend res [::log::lv2color $level]
+    }
+    set res
+} {fox fox fox fox fox fox fox fox}
+
+foreach level {alert critical debug error emergency info notice warning} {
+    test log-10.0.$level {redefining channels} {
+	set old [::log::lv2channel $level]
+	::log::lvChannel $level foo
+	set new [::log::lv2channel $level]
+	::log::lvChannel $level $old
+	set new
+    } foo
+}
+
+test log-10.1 {redefining channels} {
+    ::log::lvChannelForall fox
+    set res [list]
+    foreach level [::log::levels] {
+	lappend res [::log::lv2channel $level]
+    }
+    set res
+} {fox fox fox fox fox fox fox fox}
+
+foreach level {alert critical debug error emergency info notice warning} {
+    test log-11.0.$level {redefining cmds} {
+	set old [::log::lv2cmd $level]
+	::log::lvCmd $level foo
+	set new [::log::lv2cmd $level]
+	::log::lvCmd $level $old
+	set new
+    } foo
+}
+
+test log-11.1 {redefining cmds} {
+    ::log::lvCmdForall logMem
+    set res [list]
+    foreach level [::log::levels] {
+	lappend res [::log::lv2cmd $level]
+    }
+    set res
+} {logMem logMem logMem logMem logMem logMem logMem logMem}
+
+foreach level {alert critical debug error emergency info notice warning} {
+    test log-12.0.$level {change suppression state} {
+	set old [::log::lvIsSuppressed $level]
+	::log::lvSuppress $level
+	set new [::log::lvIsSuppressed $level]
+	::log::lvSuppress $level 0
+	lappend new [::log::lvIsSuppressed $level]
+	set new
+    } {1 0}
+}
+
+test log-12.1 {suppressor errors} {
+    if {![catch {::log::lvSuppress error foo} msg]} {
+	error "foo should be no boolean value"
+    }
+    set msg
+} {"foo" is not a member of {0, 1}}
+
+foreach {level range} {
+    emergency {1 1 1 1 1 1 1 1}
+    alert     {1 1 1 0 1 1 1 1}
+    critical  {0 1 1 0 1 1 1 1}
+    error     {0 0 1 0 1 1 1 1}
+    warning   {0 0 1 0 0 1 1 1}
+    notice    {0 0 1 0 0 1 1 0}
+    info      {0 0 1 0 0 1 0 0}
+    debug     {0 0 1 0 0 0 0 0}
+} {
+    test log-12.2.$level {change suppression state, ranges} {
+	::log::lvSuppressLE emergency 0 ; # initial full unsuppressed state
+	::log::lvSuppressLE $level
+	set res [list]
+	foreach l [::log::levels] {
+	    lappend res [::log::lvIsSuppressed $l]
+	}
+	set res
+    } $range
+}
+
+foreach {level range} {
+    debug     {1 1 0 1 1 1 1 1}
+    info      {1 1 0 1 1 0 1 1}
+    notice    {1 1 0 1 1 0 0 1}
+    warning   {1 1 0 1 1 0 0 0}
+    error     {1 1 0 1 0 0 0 0}
+    critical  {1 0 0 1 0 0 0 0}
+    alert     {0 0 0 1 0 0 0 0}
+    emergency {0 0 0 0 0 0 0 0}
+} {
+    test log-12.3.$level {change suppression state, ranges} {
+	::log::lvSuppressLE emergency ; # initial full supressed state
+	::log::lvSuppressLE $level 0
+	set res [list]
+	foreach l [::log::levels] {
+	    lappend res [::log::lvIsSuppressed $l]
+	}
+	set res
+    } $range
+}
+
+
+
+# Define our own logger command adding all messages to a global list
+# variable.
+
+global _log_
+set    _log_ [list]
+proc logMem {level text} {
+    global  _log_
+    lappend _log_ $level $text
+}
+
+# Setup some levels with different properties:
+# - Suppressed
+# - No command
+
+::log::lvCmdForall logMem
+::log::lvCmd       alert {}
+::log::lvSuppress  critical
+
+test log-13.0 {logging} {
+    set _log_ [list]
+    ::log::log emergency fofafraz
+    ::log::log alert     fofafraz1
+    ::log::log critical  fofafraz2
+    ::log::log error     fofafraz3
+    ::log::log warning   fofafraz4
+    set _log_
+} {emergency fofafraz error fofafraz3 warning fofafraz4}
+
+test log-13.1 {logging} {
+    set _log_ [list]
+    ::log::logMsg fobar
+    set _log_
+} {info fobar}
+
+test log-13.2 {logging} {
+    set _log_ [list]
+    ::log::logError buz
+    set _log_
+} {error buz}
+
+test log-13.3 {log error} {
+    if {![catch {::log::log e foobar} msg]} {
+	error "e is an unique abbreviation of a level name"
+    }
+    set msg
+} {"e" is no unique abbreviation of a level name}
+
+
+
+::tcltest::cleanupTests
+return
Index: modules/log/pkgIndex.tcl
===================================================================
RCS file: pkgIndex.tcl
diff -N pkgIndex.tcl
--- /dev/null	Mon Dec 11 17:26:27 2000
+++ pkgIndex.tcl	Tue Mar 20 16:15:09 2001
@@ -0,0 +1,11 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script.  It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands.  When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded log 1.0 [list source [file join $dir log.tcl]]
