############################################################################### # # testlog.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Test Log Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure emits a message to the specified channel and adds # it to the test log queue. # proc tqputs { channel string } { # # NOTE: If an output channel was provided, use it; otherwise, ignore # the message. # if {[string length $channel] > 0} then { puts -nonewline $channel $string } tqlog $string } # # NOTE: This procedure adds a message to the test log queue. It will be # written to the test log file the next time the [tlog] procedure # is called. If the [tlog] procedure is never called, then it will # never be written to the test log file. # proc tqlog { string } { # # NOTE: If an empty string is supplied by the caller, do nothing. # if {[string length $string] > 0} then { # # NOTE: *SPECIAL* The special global variable "test_log_queue" is used # by the [tlog] script library procedure from the test package to # enable it to emit "queued" data into the test log file prior to # emitting the string requested by its caller. The only job for # this procedure is to populate the "test_log_queue" variable for # later use by the test package. # if {[info exists ::test_log_queue]} then { # # NOTE: Use the next queued test log entry. # set entry [expr {[array size ::test_log_queue] + 1}] } else { # # NOTE: Use the first queued test log entry. # set entry 1 } # # NOTE: Add the new entry to the test log queue. All entries will be # sent to the actual test log file the very next time the [tlog] # command from the test package is executed. # set ::test_log_queue($entry) $string } return "" } # # NOTE: Provide the Eagle "test log" package to the interpreter. # package provide Eagle.Test.Log \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] }