System.Data.SQLite
Artifact Content
Not logged in

Artifact 4bceffb09cafac6f1fe09d0694bee8a2cbcc9184:


###############################################################################
#
# 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"}]
}