System.Data.SQLite
Artifact Content
Not logged in

Artifact bf04c49534a2a4968b01472bbc6ac4e4024d4807:


###############################################################################
#
# test.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Eagle Test 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 {
  proc trawputs { channel string } {
    #
    # NOTE: If an output channel was provided, use it; otherwise, ignore
    #       the message.
    #
    if {[string length $channel] > 0} then {
      #
      # NOTE: Check if output is being actively intercepted by us.
      #
      if {![isEagle] && \
          [llength [info commands ::tcl::save::puts]] > 0} then {
        ::tcl::save::puts -nonewline $channel $string
      } else {
        puts -nonewline $channel $string
      }
    }
  }

  proc tputs { channel string } {
    trawputs $channel $string; tlog $string
  }

  #
  # NOTE: This is a shim designed to act like tclLog.
  #
  proc ttclLog { string } {
    tputs $::test_channel [appendArgs $string \n]
  }

  proc doesTestLogFileExist { fileName } {
    if {[catch {
      expr {[file exists $fileName] && [file size $fileName] > 0}
    } result] == 0 && $result} then {
      return true
    } else {
      return false
    }
  }

  proc getTestLogStartSentry {} {
    if {![info exists ::test_run_id]} then {
      set ::test_run_id [getNewTestRunId]
    }

    return [appendArgs \
        "**** START OF TEST LOG \"" $::test_run_id "\" ****\n"]
  }

  proc doesTestLogHaveStartSentry {} {
    set fileName [getTestLog]

    if {[string length $fileName] > 0} then {
      if {[doesTestLogFileExist $fileName]} then {
        set sentry [string trim [getTestLogStartSentry]]

        if {[string length $sentry] > 0} then {
          set data [readFile $fileName]

          if {[string first $sentry $data] != -1} then {
            return true
          }
        }
      }
    }

    return false
  }

  proc tlog { string } {
    #
    # NOTE: If a test log file was configured, use it; otherwise, ignore the
    #       message.
    #
    set fileName [getTestLog]

    if {[string length $fileName] > 0} then {
      #
      # NOTE: Check for any queued test log data that needs to be sent to the
      #       log file prior to sending the current string.
      #
      if {[info exists ::test_log_queue]} then {
        #
        # NOTE: Process each queued test log entry, in order, sending them to
        #       the test log file (as long as they are not empty strings).
        #       Each entry is removed from the queue after it is sent to the
        #       test log file.
        #
        foreach entry [lsort -integer [array names ::test_log_queue]] {
          set newString $::test_log_queue($entry)

          if {[string length $newString] > 0} then {
            if {![doesTestLogFileExist $fileName]} then {
              set sentry [getTestLogStartSentry]

              if {[string length $sentry] > 0} then {
                appendSharedLogFile $fileName $sentry
              }
            }

            appendSharedLogFile $fileName $newString
          }

          unset ::test_log_queue($entry)
        }

        #
        # NOTE: If all entries in the test log queue were just processed,
        #       unset the entire array now.
        #
        if {[array size test_log_queue] == 0} then {
          unset ::test_log_queue
        }
      }

      #
      # NOTE: If an empty string is supplied by the caller, do nothing.
      #
      if {[string length $string] > 0} then {
        if {![doesTestLogFileExist $fileName]} then {
          set sentry [getTestLogStartSentry]

          if {[string length $sentry] > 0} then {
            appendSharedLogFile $fileName $sentry
          }
        }

        appendSharedLogFile $fileName $string
      }
    }
  }

  proc getSoftwareRegistryKey { wow64 } {
    if {$wow64 && [info exists ::tcl_platform(machine)] && [lsearch -exact \
        [list ia64 amd64 arm64] $::tcl_platform(machine)] != -1} then {
      #
      # NOTE: Return the WoW64 registry key name because we are running on a
      #       64-bit operating system and the caller specifically requested
      #       the WoW64 registry key name.
      #
      return Software\\Wow6432Node
    } else {
      #
      # NOTE: Return the native registry key name because we are either not
      #       running on a 64-bit operating system or the caller wants the
      #       native registry key name (i.e. not the WoW64 registry key name).
      #
      return Software
    }
  }

  proc haveConstraint { name } {
    if {[isEagle]} then {
      return [expr {
          [info exists ::eagle_tests(Constraints)] && \
          [lsearch -exact $::eagle_tests(Constraints) $name] != -1}]
    } else {
      return [expr {
          [info exists ::tcltest::testConstraints($name)] && \
          $::tcltest::testConstraints($name)}]
    }
  }

  proc addConstraint { name {value 1} } {
    if {[isEagle]} then {
      if {[info exists ::eagle_tests(Constraints)] && \
          [lsearch -exact $::eagle_tests(Constraints) $name] == -1 && \
          $value} then {
        lappend ::eagle_tests(Constraints) $name
      }
    } else {
      ::tcltest::testConstraint $name $value
    }

    return ""
  }

  proc haveOrAddConstraint { name {value ""} } {
    if {[isEagle]} then {
      if {[llength [info level 0]] == 2} then {
        return [haveConstraint $name]
      }

      return [addConstraint $name [expr {bool($value)}]]
    } else {
      return [::tcltest::testConstraint $name $value]
    }
  }

  proc getConstraints {} {
    set result [list]

    if {[isEagle]} then {
      if {[catch {set ::eagle_tests(Constraints)} constraints] == 0} then {
        eval lappend result $constraints
      }
    } else {
      foreach name [array names ::tcltest::testConstraints] {
        if {$::tcltest::testConstraints($name)} then {
          lappend result $name
        }
      }
    }

    return $result
  }

  proc getCachedConstraints {} {
    if {[info exists ::test_constraints] && \
        [llength $::test_constraints] > 0} then {
      return $::test_constraints
    }

    return [getConstraints]
  }

  proc useCachedConstraints {} {
    foreach name [getCachedConstraints] {
      addConstraint $name
    }
  }

  proc removeConstraint { name } {
    if {[isEagle]} then {
      if {[info exists ::eagle_tests(Constraints)]} then {
        set index [lsearch -exact $::eagle_tests(Constraints) $name]

        if {$index != -1} then {
          set ::eagle_tests(Constraints) [lreplace \
              $::eagle_tests(Constraints) $index $index]
        }
      }
    } else {
      if {[info exists ::tcltest::testConstraints($name)]} then {
        unset ::tcltest::testConstraints($name)
      }
    }

    return ""
  }

  proc fixConstraints { constraints } {
    set result [string trim $constraints]

    if {[string length $result] > 0} then {
      #
      # HACK: Fixup for the semi-magical expression (via [expr]) test
      #       constraint syntax supported by the Tcltest package and not
      #       by the Eagle.Test package.  This needs to happen for Tcl
      #       in test constraints that contain any characters that are
      #       not alphanumeric, not a period, and not a colon (e.g. in
      #       this case, the exclamation point); however, it should only
      #       be required when the number of test constraints is greater
      #       than one.
      #
      if {![isEagle]} then {
        if {[string first ! $result] != -1} then {
          #
          # HACK: All of our test constraints assume they are
          #       "logically and-ed" together.
          #
          set result [join [split $result] " && "]
        }
      }
    }

    return $result
  }

  proc fixTimingConstraints { constraints } {
    #
    # HACK: In Eagle, when the right test constraint is present, *any* tests
    #       where PASSED / FAILED results can vary non-deterministically due
    #       to timing issues (e.g. performance) are forbidden from causing
    #       the overall test run to fail.
    #
    if {[isEagle] && [haveConstraint officialStableReleaseInProgress]} then {
      return [fixConstraints [concat $constraints [list fail.false]]]
    } else {
      return [fixConstraints $constraints]
    }
  }

  proc testDebugBreak {} {
    if {[isEagle]} then {
      #
      # NOTE: In Eagle, simply break into the interactive loop using the
      #       integrated script debugger.
      #
      debug break
    } else {
      #
      # NOTE: In native Tcl, attempt to use the TclPro Debugger interface.
      #       This requires that the TclPro Debugger interface package be
      #       present somewhere along the auto-path.
      #
      package require tcldebugger_attach; debugger_init; debugger_break
    }
  }

  proc testArrayGet { varName {integer false} } {
    #
    # NOTE: Returns the results of [array get] in a well-defined order.
    #
    if {[string length $varName] == 0} then {
      return [list]
    }

    #
    # NOTE: Refer to the array in the context of the caller.
    #
    upvar 1 $varName array

    #
    # NOTE: Build the command that will sort the array names into order.
    #
    set command [list lsort]
    if {$integer} then {lappend command -integer}
    lappend command [array names array]

    set result [list]

    foreach name [eval $command] {
      lappend result $name $array($name)
    }

    return $result
  }

  proc testArrayGet2 { varName {pattern ""} {integer false} } {
    #
    # NOTE: Returns the results of [array get] in a well-defined order.
    #
    if {[string length $varName] == 0} then {
      return [list]
    }

    #
    # NOTE: Refer to the array in the context of the caller.
    #
    upvar 1 $varName array

    #
    # NOTE: Build the command that will sort the array names into order.
    #
    set command [list lsort]
    if {$integer} then {lappend command -integer}

    #
    # NOTE: If there is a pattern, use it; otherwise, all elements are
    #       returned.
    #
    if {[string length $pattern] > 0} then {
      lappend command [array names array $pattern]
    } else {
      lappend command [array names array]
    }

    set result [list]

    foreach name [eval $command] {
      lappend result $name $array($name)
    }

    return $result
  }

  proc testResultGet { script } {
    set code [catch {uplevel 1 $script} result]
    return [expr {$code == 0 ? $result : "<error>"}]
  }

  proc testValueGet { varName {integer false} } {
    #
    # NOTE: Returns the results of [array get] in a well-defined order
    #       -OR- the value of the scalar variable.
    #
    if {[string length $varName] == 0} then {
      return [list]
    }

    #
    # NOTE: Is the specified variable (in the context of the caller) an
    #       array?
    #
    if {[uplevel 1 [list array exists $varName]]} then {
      #
      # NOTE: Refer to the array in the context of the caller.
      #
      upvar 1 $varName array

      #
      # NOTE: Build the command that will sort the array names into order.
      #
      set command [list lsort]
      if {$integer} then {lappend command -integer}
      lappend command [array names array]

      set result [list]

      foreach name [eval $command] {
        lappend result $name $array($name)
      }
    } else {
      #
      # NOTE: Grab the value of the scalar variable in the context of the
      #       caller and then return both the name and the value.
      #
      set varValue [uplevel 1 [list set $varName]]
      set result [list $varValue]
    }

    return $result
  }

  proc getFirstLineOfError { error } {
    set error [string map [list \r\n \n] $error]
    set index [string first \n $error]

    if {$index != -1} then {
      incr index -1

      if {$index > 0} then {
        return [string range $error 0 $index]
      }
    }

    return $error
  }

  proc calculateBogoCops { {milliseconds 2000} {legacy false} } {
    #
    # NOTE: Verify that the number of milliseconds requested is greater than
    #       zero.
    #
    if {$milliseconds <= 0} then {
      unset -nocomplain ::test_suite_running
      error "number of milliseconds must be greater than zero"
    }

    #
    # HACK: Different techniques are used to calculate the performance of the
    #       machine for Tcl and Eagle.
    #
    if {!$legacy && [isEagle]} then {
      #
      # NOTE: Save the current readiness limit for later restoration and then
      #       set the current readiness limit to always check the interpreter
      #       readiness (default).  If this was not done, the [interp cancel]
      #       command in this procedure may have no effect, which could cause
      #       this procedure to run forever.
      #
      set readylimit [interp readylimit {}]
      interp readylimit {} 0

      try {
        #
        # NOTE: Save the current background error handler for later restoration
        #       and then reset the current background error handler to nothing.
        #
        set bgerror [interp bgerror {}]
        interp bgerror {} ""

        try {
          #
          # NOTE: Save the current [after] flags for later restoration and then
          #       reset them to process events immediately.
          #
          set flags [after flags]
          after flags =Immediate

          try {
            set code [catch {
              #
              # NOTE: First, make sure that the [after] event queue for the
              #       interpreter is totally empty.
              #
              catch {foreach id [after info] {after cancel $id}}

              #
              # NOTE: Schedule the event to cancel the script we are about to
              #       evaluate, capturing the name so we can cancel it later,
              #       if necessary.
              #
              set event [after $milliseconds [list interp cancel]]

              #
              # HACK: There is a potential "race condition" here.  If the
              #       specified number of milliseconds elapses before (or
              #       after) entering the [catch] script block (below) then
              #       the resulting script cancellation error will not be
              #       caught and we will be unable to return the correct
              #       result to the caller.
              #
              set before [info cmdcount]
              catch {time {nop} -1}; # uses the [time] internal busy loop.
              set after [info cmdcount]

              #
              # HACK: Mono has a bug that results in excessive trailing zeros
              #       here (Mono bug #655780).
              #
              if {[isMono]} then {
                expr {double(($after - $before) / ($milliseconds / 1000.0))}
              } else {
                expr {($after - $before) / ($milliseconds / 1000.0)}
              }
            } result]

            #
            # NOTE: If we failed due to the race condition explained above,
            #       return an obviously invalid result instead.
            #
            if {$code == 0} then {
              return $result
            } else {
              return 0
            }
          } finally {
            if {[info exists event]} then {
              catch {after cancel $event}
            }

            after flags [appendArgs = $flags]
          }
        } finally {
          interp bgerror {} $bgerror
        }
      } finally {
        interp readylimit {} $readylimit
      }
    } else {
      #
      # NOTE: Record the initial Tcl command count.
      #
      set before [info cmdcount]

      #
      # NOTE: Calculate how many whole seconds we need to spin for.
      #
      set seconds [expr {$milliseconds / 1000}]

      #
      # NOTE: Calculate the starting and ending values of [clock seconds].
      #
      set now [clock seconds]
      set start $now; set stop [expr {$now + $seconds}]

      #
      # NOTE: Do nothing for X seconds (i.e. except call [clock seconds]).
      #
      while {$start <= $now && $now < $stop} {set now [clock seconds]}

      #
      # NOTE: Record the final Tcl command count.
      #
      set after [info cmdcount]

      #
      # NOTE: Calculate approximately how many Tcl commands per second were
      #       executed during the timed loop (above).  Due to various things,
      #       including overhead associated with [clock seconds], this number
      #       is not as accurate as the one for Eagle; however, it's generally
      #       good enough.
      #
      expr {($after - $before) / double($seconds)}
    }
  }

  proc calculateRelativePerformance { type value } {
    #
    # NOTE: Adjust the expected performance number based on the
    #       relative performance of this machine, if available.
    #
    if {[info exists ::test_base_cops] && [info exists ::test_cops]} then {
      #
      # NOTE: Calibrate the expected performance numbers based
      #       on the ratio of the baseline performace to the
      #       current performance.
      #
      switch -exact -- $type {
        elapsed {
          if {$::test_cops != 0} then {
            return [expr {double($value) * \
                ($::test_base_cops / $::test_cops)}]
          }
        }
        iterations {
          if {$::test_base_cops != 0} then {
            return [expr {double($value) * \
                ($::test_cops / $::test_base_cops)}]
          }
        }
      }
    }

    return $value
  }

  proc formatTimeStamp { seconds {gmt false} } {
    if {[isEagle]} then {
      return [clock format $seconds -gmt $gmt -iso -isotimezone]
    } else {
      return [clock format $seconds -gmt $gmt -format "%Y-%m-%dT%H:%M:%S %Z"]
    }
  }

  proc formatElapsedTime { seconds } {
    if {[isEagle] && [llength [info commands object]] > 0} then {
      #
      # NOTE: Create a TimeSpan instance based on the number of whole
      #       seconds.
      #
      set timeSpan [object invoke -create -alias TimeSpan FromSeconds \
          $seconds]

      #
      # NOTE: Return the number of seconds and a human readable string
      #       representing the TimeSpan instance created based on that
      #       same number of seconds.
      #
      return [appendArgs $seconds " seconds (" [$timeSpan ToString] \
          " elapsed time)"]
    } else {
      #
      # NOTE: Unfortunately, there is no built-in native Tcl command
      #       that can correctly format an elapsed time; therefore,
      #       just return the number of whole seconds.
      #
      return [appendArgs $seconds " seconds"]
    }
  }

  proc sourceIfValid { type fileName } {
    if {[string length $fileName] > 0} then {
      if {[file exists $fileName]} then {
        tputs $::test_channel [appendArgs \
            "---- evaluating " $type " file: \"" $fileName \"\n]

        if {[catch {uplevel 1 [list source $fileName]} error]} then {
          tputs $::test_channel [appendArgs \
              "---- error during " $type " file: " $error \n]

          #
          # NOTE: The error has been logged, now re-throw it.
          #
          unset -nocomplain ::test_suite_running
          error $error $::errorInfo $::errorCode
        }
      } else {
        tputs $::test_channel [appendArgs \
            "---- skipped " $type " file: \"" $fileName \
            "\", it does not exist\n"]
      }
    }
  }

  proc processTestArguments { varName strict args } {
    #
    # NOTE: Initially, there are no unknown (i.e. unprocessed) arguments.
    #
    set result [list]

    #
    # NOTE: We are going to place the configured options in the variable
    #       identified by the name provided by the caller.
    #
    if {[string length $varName] > 0} then {
      upvar 1 $varName array
    }

    #
    # TODO: Add more support for standard "tcltest" options here.
    #
    set options [list \
        -breakOnLeak -configuration -constraints -exitOnComplete \
        -file -logFile -machine -match -no -notFile -platform \
        -postTest -preTest -postWait -preWait -randomOrder -skip \
        -startFile -stopFile -stopOnFailure -stopOnLeak -suffix \
        -suite -tclsh -threshold -uncountedLeaks -verbose]

    set length [llength $args]

    for {set index 0} {$index < $length} {incr index} {
      #
      # NOTE: Grab the current list element, which should be the name of
      #       the test option.
      #
      set name [lindex $args $index]

      #
      # NOTE: Use the [tqputs] command here just in case the test log file
      #       has not been setup yet (i.e. by default, this procedure is
      #       almost always called by the test prologue file prior to the
      #       test log file having been setup and we do not want to just
      #       lose this output).
      #
      if {[lsearch -exact $options $name] != -1} then {
        #
        # NOTE: Is there another list element available for the value?  If
        #       not, this is not a valid test option.
        #
        if {$index + 1 < $length} then {
          incr index; set value [lindex $args $index]

          set array($name) $value

          tqputs $::test_channel [appendArgs \
              "---- overrode test option \"" $name "\" with value \"" \
              $value \"\n]
        } else {
          tqputs $::test_channel [appendArgs \
              "---- no value for test option \"" $name "\", ignored\n"]
        }
      } elseif {[string index $name 0] eq "-"} then {
        #
        # NOTE: Is there another list element available for the value?  If
        #       not, it does not conform to the standard command line name
        #       and value pattern.
        #
        if {$index + 1 < $length} then {
          incr index; set value [lindex $args $index]

          if {!$strict && [lsearch -exact $options $value] != -1} then {
            incr index -1; # HACK: Resynchronize with valid test option.
            lappend result [list $name]

            tqputs $::test_channel [appendArgs \
                "---- no value for unknown test option \"" $name \
                "\", ignored, backing up one for test option \"" \
                $value \"...\n]
          } else {
            lappend result [list $name $value]

            tqputs $::test_channel [appendArgs \
                "---- unknown test option \"" $name "\" with value \"" \
                $value "\", ignored\n"]
          }
        } else {
          lappend result [list $name]

          tqputs $::test_channel [appendArgs \
              "---- no value for unknown test option \"" $name \
              "\", ignored\n"]
        }
      } else {
        #
        # NOTE: Is there another list element available for the value?  If
        #       not, it does not conform to the standard command line name
        #       and value pattern.
        #
        if {$index + 1 < $length} then {
          incr index; set value [lindex $args $index]

          if {!$strict && [lsearch -exact $options $value] != -1} then {
            incr index -1; # HACK: Resynchronize with valid test argument.
            lappend result [list $name]

            tqputs $::test_channel [appendArgs \
                "---- no value for unknown argument \"" $name \
                "\", ignored, backing up one for test option \"" \
                $value \"...\n]
          } else {
            lappend result [list $name $value]

            tqputs $::test_channel [appendArgs \
                "---- unknown argument \"" $name "\" with value \"" \
                $value "\", ignored\n"]
          }
        } else {
          #
          # NOTE: This is not an option of *any* kind that we know about.
          #       Ignore it and issue a warning.
          #
          lappend result [list $name]

          tqputs $::test_channel [appendArgs \
              "---- unknown argument \"" $name "\", ignored\n"]
        }
      }
    }

    #
    # NOTE: Now, attempt to flush the test log queue, if available.
    #
    tlog ""

    #
    # NOTE: Return the nested list of unknown arguments, formatted as
    #       name/value pairs, to the caller.
    #
    return $result
  }

  proc getTclShellFileName { automatic kits machine } {
    #
    # NOTE: Start out with an empty list of candiate Tcl shells.
    #
    set shells [list]

    #
    # NOTE: Figure out the environment variables to be checked.  If
    #       there was a machine specified, it will be used to check
    #       for machine-specific Tcl shells.
    #
    set names [list]

    foreach name [list Eagle_Tcl_Shell Tcl_Shell EAGLE_TCLSH TCLSH] {
      if {[string length $machine] > 0} then {
        set platform [machineToPlatform $machine true]

        if {[string length $platform] > 0} then {
          lappend names [appendArgs $name _ $platform]
        }

        set platform [machineToPlatform $machine false]

        if {[string length $platform] > 0} then {
          lappend names [appendArgs $name _ $platform]
        }

        lappend names [appendArgs $name _ $machine]
      }

      lappend names $name
    }

    #
    # NOTE: Check all environment variables (we know about) that
    #       may contain the path where the Tcl shell is located.
    #
    foreach name $names {
      #
      # NOTE: Grab the value of the environment variable.  This
      #       will be an empty string if it was not set.
      #
      set value [getEnvironmentVariable $name]

      #
      # TODO: Possibly add a check if the file actually exists
      #       here.
      #
      if {[string length $value] > 0} then {
        #
        # NOTE: *EXTERNAL* Use verbatim, no normalization.
        #
        if {$automatic && [isEagle]} then {
          #
          # NOTE: In automatic mode, the environment variable
          #       value simply represents another candidate
          #       Tcl shell (i.e. it does not halt the search
          #       for other candidate Tcl shells).
          #
          lappend shells $value
        } else {
          #
          # NOTE: In manual mode, the environment variable
          #       value represents an "override" and halts
          #       the search for other candidate Tcl shells.
          #
          return $value
        }
      }
    }

    #
    # NOTE: The automatic Tcl shell detection is only available when
    #       running in Eagle.
    #
    if {[isEagle]} then {
      #
      # NOTE: Attempt to check for the "best" available dynamically
      #       loadable Tcl library and then attempt to use its
      #       "associated" Tcl shell.  A very similar block of code
      #       is also used by the [checkForTclInstalls] procedure
      #       in the constraints package.
      #
      if {[catch {tcl select -architecture} tcl] == 0} then {
        #
        # NOTE: Should we also consider TclKit shells?  If so, a bit
        #       more handling is required.
        #
        if {$kits} then {
          #
          # NOTE: Did we find one?  Attempt to grab the patch
          #       level field from the returned dictionary value.
          #
          set dotPatchLevel [getDictionaryValue $tcl patchLevel]

          #
          # NOTE: Verify that the patch level we found is valid
          #       and that it conforms to the pattern we expect.
          #
          if {[string length $dotPatchLevel] > 0 && \
            [regexp -- {^\d+\.\d+\.\d+$} $dotPatchLevel]} then {
            #
            # NOTE: Build the candidate TclKit shell executable file
            #       name with the dot-separated patch level.  This is
            #       the common naming scheme on Unix.
            #
            set dotShell [appendArgs tclkit- $dotPatchLevel]

            #
            # NOTE: Build the candidate TclKit shell executable file
            #       name with the patch level, removing the dot.  This
            #       is the common naming scheme on Windows.
            #
            set shell [appendArgs \
                tclkit- [string map [list . ""] $dotPatchLevel]]

            #
            # NOTE: Always favor the TclKit shell executable file
            #       naming scheme for the current operating system
            #       first.
            #
            if {[isWindows]} then {
              lappend shells $shell
              lappend shells $dotShell
            } else {
              lappend shells $dotShell
              lappend shells $shell
            }
          }
        }

        #
        # NOTE: Did we find one?  Attempt to grab the version
        #       field from the returned dictionary value.
        #
        set dotVersion [getDictionaryValue $tcl version]

        #
        # NOTE: Verify that the version we found is valid and that
        #       it conforms to the pattern we expect.
        #
        if {[string length $dotVersion] > 0 && \
            [regexp -- {^\d+\.\d+$} $dotVersion]} then {
          #
          # NOTE: Gather the list of candidate Tcl shells to check
          #       using the range of versions we are interested in,
          #       starting with the "best" available version and
          #       ending with the absolute minimum version supported
          #       by the Eagle core library.  A very similar block
          #       of code is also used by the [checkForTclShell]
          #       procedure in the constraints package.
          #
          foreach version [lsort -real -decreasing [tcl \
              versionrange -maximumversion $dotVersion]] {
            #
            # NOTE: Build the candidate Tcl shell executable file name
            #       with the dot-separated version.  This is the common
            #       naming scheme on Unix.
            #
            set dotShell [appendArgs tclsh $version]

            #
            # NOTE: Build the candidate Tcl shell executable file name
            #       with the version, removing the dot.  This is the
            #       common naming scheme on Windows.
            #
            set shell [appendArgs tclsh [string map [list . ""] $version]]

            #
            # NOTE: Always favor the Tcl shell executable file naming
            #       scheme for the current operating system first.
            #
            if {[isWindows]} then {
              lappend shells $shell
              lappend shells $dotShell
            } else {
              lappend shells $dotShell
              lappend shells $shell
            }
          }
        }
      }

      #
      # NOTE: Check each candidate Tcl shell and query its fully
      #       qualified path from it.  If it cannot be executed,
      #       we know that candidate Tcl shell is not available.
      #
      foreach shell $shells {
        if {[catch {
          getTclExecutableForTclShell $shell
        } executable] == 0 && $executable ne "error"} then {
          #
          # NOTE: It looks like this Tcl shell is available.
          #       Return the fully qualified path to it now.
          #
          return $executable
        }
      }
    }

    #
    # NOTE: Return the fallback default.
    #
    return tclsh
  }

  proc getTemporaryPath {} {
    #
    # NOTE: Build the list of "temporary directory" override
    #       environment variables to check.
    #
    set names [list]

    foreach name [list EAGLE_TEST_TEMP EAGLE_TEMP TEMP TMP] {
      #
      # NOTE: Make sure we handle all the reasonable "cases" of
      #       the environment variable names.
      #
      lappend names [string toupper $name] [string tolower $name] \
          [string totitle $name]
    }

    #
    # NOTE: Check if we can use any of the environment variables.
    #
    foreach name $names {
      set value [getEnvironmentVariable $name]

      if {[string length $value] > 0} then {
        return [file normalize $value]
      }
    }

    if {[isEagle] && [llength [info commands object]] > 0} then {
      #
      # NOTE: Eagle fallback, use whatever is reported by the
      #       underlying framework and/or operating system.
      #
      return [file normalize [object invoke System.IO.Path GetTempPath]]
    } else {
      #
      # NOTE: Tcl fallback, *assume* that we can use the
      #       directory where the executable is running for
      #       temporary storage.
      #
      return [file normalize [file dirname [info nameofexecutable]]]
    }
  }

  proc getTemporaryFileName { {seconds 5} } {
    if {[isEagle]} then {
      return [file tempname]
    } else {
      set path [getTemporaryPath]

      set now [clock seconds]
      set start $now; set stop [expr {$now + $seconds}]

      while {$start <= $now && $now < $stop} {
        binary scan [binary format d* [expr {rand()}]] h* random

        set fileNameOnly [appendArgs \
            tmp [string index $random 0] [string index $random 1] \
            [string index $random end-1] [string index $random end] \
            .tmp]

        set fileName [file join $path $fileNameOnly]

        if {![file exists $fileName]} then {
          return $fileName
        }

        set now [clock seconds]
      }

      error "cannot generate temporary file name"
    }
  }

  proc getFiles { directory pattern } {
    if {[isEagle]} then {
      set result [list]

      if {[file exists $directory] && [file isdirectory $directory]} then {
        foreach fileName [lsort -dictionary [file list $directory $pattern]] {
          if {[file isfile $fileName] && [file readable $fileName]} then {
            lappend result $fileName
          }
        }
      }

      return $result
    } else {
      return [lsort -dictionary [glob -directory $directory -types \
          {f r} -nocomplain -- $pattern]]
    }
  }

  proc getTestFiles { directories matchFilePatterns skipFilePatterns } {
    set result [list]

    foreach directory $directories {
      set matchFileNames [list]

      foreach pattern $matchFilePatterns {
        eval lappend matchFileNames [getFiles $directory $pattern]
      }

      set skipFileNames [list]

      foreach pattern $skipFilePatterns {
        eval lappend skipFileNames [getFiles $directory $pattern]
      }

      foreach fileName $matchFileNames {
        if {[lsearch -exact $skipFileNames $fileName] == -1} then {
          lappend result $fileName
        }
      }
    }

    return $result
  }

  proc getTestRunId {} {
    return [expr {[info exists ::test_run_id] ? $::test_run_id : ""}]
  }

  proc getNewTestRunId {} {
    #
    # HACK: Yes, this is a bit ugly; however, it creates a nice unique
    #       identifier to represent the test run, which makes analyzing
    #       the test log files a lot easier.
    #
    if {[isEagle]} then {
      #
      # BUGBUG: Tcl 8.4 does not like this expression (and Tcl tries to
      #         compile it even though it will only actually ever be
      #         evaluated in Eagle).
      #
      set expr {random()}

      #
      # NOTE: Include the host name to make the result more unique in both
      #       time and space.  Also, hash the entire constructed string.
      #
      if {![isMono]} then {
        #
        # NOTE: When running on the .NET Framework, we can simply use the
        #       [string format] command.
        #
        return [hash normal sha256 [string format \
            "{0}{1:X8}{2:X8}{3:X16}{4:X16}{5:X16}" [info host] [pid] \
            [info tid] [clock now] [clock clicks] [expr $expr]]]
      } else {
        #
        # HACK: Mono does not currently support calling the String.Format
        #       overload that takes a variable number of arguments via
        #       reflection (Mono bug #636939).  Also, strip any leading
        #       minus signs for cleanliness.
        #
        return [hash normal sha256 [appendArgs [info host] [string \
            trimleft [pid] -] [string trimleft [info tid] -] [string \
            trimleft [clock now] -] [string trimleft [clock clicks] -] \
            [string trimleft [expr $expr] -]]]
      }
    } else {
      #
      # NOTE: Generate a random number using [expr] and then convert it
      #       to a 64-bit integer.
      #
      binary scan [binary format d* [expr {rand()}]] w* random

      #
      # NOTE: Convert the host name to a hexadecimal string and include
      #       it in the result in an attempt to make it more unique in
      #       both time and space.
      #
      binary scan [info host] c* host
      set host [eval [list format [string repeat %X [llength $host]]] $host]

      #
      # NOTE: Build the final result with the [format] command, converting
      #       all the pieces to hexadecimal (except the host, which is
      #       already hexadecimal).
      #
      set pid [pid]; set seconds [clock seconds]; set clicks [clock clicks]

      return [appendArgs \
          $host [format [appendArgs % [getLengthModifier $pid] X% \
          [getLengthModifier $seconds] X% [getLengthModifier $clicks] X% \
          [getLengthModifier $random] X] $pid $seconds $clicks $random]]
    }
  }

  proc getTestLogId {} {
    return [expr {[info exists ::test_log_id] ? \
        [append result . $::test_log_id] : ""}]
  }

  proc getDefaultTestLog {} {
    set executable [info nameofexecutable]

    if {![info exists ::no(temporaryTestLog)]} then {
      set path [getTemporaryPath]
    } else {
      set path [file dirname $executable]
    }

    return [file join $path [appendArgs \
        [file tail $executable] [getTestLogId] .test. [pid] .log]]
  }

  proc getTestLog {} {
    return [expr {[info exists ::test_log] ? $::test_log : ""}]
  }

  proc getLastTestLog {} {
    #
    # NOTE: Use the configured log file name -OR- what the configured
    #       log file name would be, by default, if it actually existed.
    #
    if {[info exists ::test_log]} then {
      set logFileName $::test_log
    } else {
      set logFileName [getDefaultTestLog]
    }

    set logFileName [file normalize $logFileName]
    set logTime [expr {[file exists $logFileName] ? \
        [file mtime $logFileName] : 0}]

    #
    # NOTE: Make the log file name into a pattern we can use to find
    #       the related log files.
    #
    if {[regsub -- {\.\d+\.} $logFileName {.*.} pattern]} then {
      set lastLogFile [list]

      foreach fileName [findFiles $pattern] {
        #
        # NOTE: Skip the current test log file, if found.
        #
        if {[isSameFileName $fileName $logFileName]} then {
          continue
        }

        #
        # NOTE: When was this log file last modified?
        #
        set time [file mtime $fileName]

        #
        # NOTE: Check if there has been no log file seen -OR- this
        #       log file has the latest modified time seen.
        #
        if {[llength $lastLogFile] == 0 || \
            $time > [lindex $lastLogFile 0]} then {
          #
          # NOTE: This is now the latest log file seen.
          #
          set lastLogFile [list $time $fileName]
        }
      }

      #
      # NOTE: Either return the last log file seen, if any -OR- the
      #       configured log file, if it actually exists.
      #
      if {[llength $lastLogFile] > 0} then {
        return [lindex $lastLogFile 1]
      } elseif {$logTime != 0} then {
        return $logFileName
      }
    }

    return ""
  }

  proc getTestSuite {} {
    #
    # NOTE: Determine the effective test suite name and return it.  If the
    #       test suite name cannot be determined, return the default based
    #       on whether we are running in Eagle or native Tcl.
    #
    if {[info exists ::test_flags(-suite)] && \
        [string length $::test_flags(-suite)] > 0} then {
      #
      # NOTE: The test suite name has been manually overridden via the test
      #       flags; therefore, use it.
      #
      return $::test_flags(-suite)
    } elseif {[info exists ::test_suite]} then {
      #
      # NOTE: Use the test suite name.  The default value is set by the test
      #       suite prologue; however, this may have been overridden.
      #
      return $::test_suite
    } elseif {[isEagle]} then {
      #
      # NOTE: Use the default test suite name for Eagle.
      #
      return "Eagle Test Suite for Eagle"
    } else {
      #
      # NOTE: Use the default test suite name for native Tcl.
      #
      return "Eagle Test Suite for Tcl"
    }
  }

  proc getTestMachine {} {
    #
    # NOTE: Determine the effective test machine and return it.  If the
    #       test machine cannot be determined, return an empty string.
    #
    if {[info exists ::test_flags(-machine)] && \
        [string length $::test_flags(-machine)] > 0} then {
      #
      # NOTE: The test machine has been manually overridden via the test
      #       flags; therefore, use it.
      #
      return $::test_flags(-machine)
    } elseif {[info exists ::test_machine]} then {
      #
      # NOTE: Use the test machine.  The default value is set by the test
      #       suite prologue; however, this may have been overridden.
      #
      return $::test_machine
    } elseif {[info exists ::tcl_platform(machine)]} then {
      #
      # NOTE: Use the build machine of Eagle itself.
      #
      return $::tcl_platform(machine)
    } else {
      #
      # NOTE: We are missing the machine, return nothing.
      #
      return ""
    }
  }

  proc getTestPlatform { {architecture false} } {
    #
    # NOTE: Determine the effective test platform and return it.  If the
    #       test platform cannot be determined, return an empty string.
    #
    if {[info exists ::test_flags(-platform)] && \
        [string length $::test_flags(-platform)] > 0} then {
      #
      # NOTE: The test platform has been manually overridden via the test
      #       flags; therefore, use it.
      #
      return $::test_flags(-platform)
    } elseif {[info exists ::test_platform]} then {
      #
      # NOTE: Use the test platform.  The default value is set by the test
      #       suite prologue; however, this may have been overridden.
      #
      return $::test_platform
    } else {
      set machine [getTestMachine]

      if {[string length $machine] > 0} then {
        #
        # NOTE: Use the machine architecture to figure out the platform
        #       and then return it.
        #
        return [machineToPlatform $machine $architecture]
      } else {
        #
        # NOTE: We are missing the machine and we cannot figure out the
        #       platform without it; therefore, return nothing.
        #
        return ""
      }
    }
  }

  proc getTestConfiguration {} {
    #
    # NOTE: Determine the effective test configuration and return it.  If
    #       the test configuration cannot be determined, return an empty
    #       string.
    #
    if {[info exists ::test_flags(-configuration)] && \
        [string length $::test_flags(-configuration)] > 0} then {
      #
      # NOTE: The test configuration has been manually overridden via the
      #       test flags; therefore, use it.
      #
      return $::test_flags(-configuration)
    } elseif {[info exists ::test_configuration]} then {
      #
      # NOTE: Use the test configuration.  The default value is set by the
      #       test suite prologue; however, this may have been overridden.
      #
      return $::test_configuration
    } elseif {[info exists ::eagle_platform(configuration)]} then {
      #
      # NOTE: Use the build configuration of Eagle itself.  This value will
      #       most likely be either "Debug" or "Release".
      #
      return $::eagle_platform(configuration)
    } else {
      #
      # NOTE: We are missing the configuration, return nothing.
      #
      return ""
    }
  }

  proc getTestSuffix {} {
    #
    # NOTE: Determine the effective test suffix and return it.  If
    #       the test suffix cannot be determined, return an empty
    #       string.
    #
    if {[info exists ::test_flags(-suffix)] && \
        [string length $::test_flags(-suffix)] > 0} then {
      #
      # NOTE: The test suffix has been manually overridden via the
      #       test flags; therefore, use it.
      #
      return $::test_flags(-suffix)
    } elseif {[info exists ::test_suffix]} then {
      #
      # NOTE: Use the test suffix.  There is no default value for
      #       this variable (i.e. by default, it does not exist).
      #
      return $::test_suffix
    } elseif {[info exists ::eagle_platform(text)] && \
        [string length $::eagle_platform(text)] > 0} then {
      #
      # NOTE: Use the build "text" of Eagle itself.  This value
      #       will typically be "NetFx20", "NetFx40", etc.  The
      #       default value of this element is an empty string.
      #
      return $::eagle_platform(text)
    } elseif {[info exists ::eagle_platform(suffix)] && \
        [string length $::eagle_platform(suffix)] > 0} then {
      #
      # NOTE: Use the build suffix of Eagle itself.  This value
      #       will typically be "NetFx20", "NetFx40", etc.  The
      #       default value of this element is an empty string.
      #
      return $::eagle_platform(suffix)
    } else {
      #
      # NOTE: We are missing the suffix, return nothing.
      #
      return ""
    }
  }

  proc getTestUncountedLeaks {} {
    if {[info exists ::test_uncounted_leaks] && \
        [string length $::test_uncounted_leaks] > 0} then {
      return $::test_uncounted_leaks
    }

    return [list]
  }

  proc getRuntimeAssemblyName {} {
    if {[isEagle]} then {
      if {[isDotNetCore]} then {
        if {[llength [info commands object]] > 0} then {
          #
          # HACK: The core runtime assembly (i.e. the one containing
          #       System.Object, et al) must have already been loaded
          #       (?), so just abuse the [object load] sub-command to
          #       return its assembly name.
          #
          return [lindex [object load System.Private.CoreLib] 0]
        } else {
          #
          # HACK: The [object] command is unavailable, just fake it.
          #
          return "System.Private.CoreLib, Version=4.0.0.0,\
              Culture=neutral, PublicKeyToken=7cec85d7bea7798e"
        }
      } else {
        if {[llength [info commands object]] > 0} then {
          #
          # HACK: The core runtime assembly (i.e. the one containing
          #       System.Object, et al) must have already been loaded
          #       (?), so just abuse the [object load] sub-command to
          #       return its assembly name.
          #
          return [lindex [object load mscorlib] 0]
        } else {
          #
          # HACK: The [object] command is unavailable, just fake it.
          #
          if {[info exists ::eagle_platform(runtimeVersion)] && \
              [string index $::eagle_platform(runtimeVersion) 0] >= 4} then {
            #
            # BUGBUG: Does not handle a major CLR version greater than
            #         four (4).
            #
            return "mscorlib, Version=4.0.0.0, Culture=neutral,\
                PublicKeyToken=b77a5c561934e089"
          } else {
            return "mscorlib, Version=2.0.0.0, Culture=neutral,\
                PublicKeyToken=b77a5c561934e089"
          }
        }
      }
    } else {
      #
      # HACK: Native Tcl has no runtime assembly name as it is native.
      #
      return ""
    }
  }

  proc getTestAssemblyName {} {
    if {[isEagle]} then {
      return [lindex [split [lindex [info assembly] 0] ,] 0]
    } else {
      return Eagle
    }
  }

  #
  # NOTE: This procedure should return non-zero if the [exec] command may be
  #       used by the specified test package procedure.
  #
  proc canTestExec { procName } {
    if {[info exists ::no(exec)]} then {
      return false
    }

    if {[info exists ::no(canTestExec)]} then {
      return false
    }

    if {[string length $procName] > 0 && \
        [info exists [appendArgs ::no(canTestExec. $procName )]]} then {
      return false
    }

    return true
  }

  proc testExec { commandName options args } {
    set command [list exec]

    if {[llength $options] > 0} then {eval lappend command $options}

    lappend command -- $commandName

    if {[llength $args] > 0} then {eval lappend command $args}
    set procName [lindex [info level [info level]] 0]

    if {![canTestExec $procName]} then {
      tputs $::test_channel [appendArgs "---- skipping command: " $command \n]

      error "test use of \[$procName\] has been disabled"
    } else {
      tputs $::test_channel [appendArgs "---- running command: " $command \n]

      return [uplevel 1 $command]
    }
  }

  proc testClrExec { commandName options args } {
    set command [list exec]

    if {[llength $options] > 0} then {eval lappend command $options}

    lappend command --

    #
    # HACK: Assume that Mono is somewhere along the PATH.
    #
    if {[isMono]} then {
      lappend command mono \
          [appendArgs \" [file nativename $commandName] \"]
    } else {
      #
      # HACK: When running on .NET Core, need to insert "dotnet exec"
      #       command line arguments before command to execute.
      #
      if {[isDotNetCore]} then {
        lappend command dotnet exec \
            [appendArgs \" [file nativename $commandName] \"]
      } else {
        lappend command $commandName
      }
    }

    if {[llength $args] > 0} then {eval lappend command $args}
    set procName [lindex [info level [info level]] 0]

    if {![canTestExec $procName]} then {
      tputs $::test_channel [appendArgs "---- skipping command: " $command \n]

      error "test use of \[$procName\] has been disabled"
    } else {
      tputs $::test_channel [appendArgs "---- running command: " $command \n]

      return [uplevel 1 $command]
    }
  }

  proc execTestShell { options args } {
    set procName [lindex [info level [info level]] 0]

    if {![canTestExec $procName]} then {
      tputs $::test_channel [appendArgs \
          "---- skipping nested shell: exec " [string trim [appendArgs \
          $options " " -- " \"" [info nameofexecutable] "\" " $args]] \n]

      error "test use of \[$procName\] has been disabled"
    } else {
      tputs $::test_channel [appendArgs \
          "---- running nested shell: exec " [string trim [appendArgs \
          $options " " -- " \"" [info nameofexecutable] "\" " $args]] \n]

      return [uplevel 1 execShell [list $options] $args]
    }
  }

  proc isRandomOrder {} {
    return [expr {[info exists ::test_random_order] && \
                  [string is boolean -strict $::test_random_order] && \
                  $::test_random_order}]
  }

  proc isBreakOnLeak {} {
    return [expr {[info exists ::test_break_on_leak] && \
                  [string is boolean -strict $::test_break_on_leak] && \
                  $::test_break_on_leak}]
  }

  proc isBreakOnDemand {} {
    global env

    return [expr {[info exists env(isBreakOnDemand)] && \
                  [string is boolean -strict $env(isBreakOnDemand)] && \
                  $env(isBreakOnDemand)}]
  }

  proc isStopOnFailure {} {
    return [expr {[info exists ::test_stop_on_failure] && \
                  [string is boolean -strict $::test_stop_on_failure] && \
                  $::test_stop_on_failure}]
  }

  proc isStopOnLeak {} {
    return [expr {[info exists ::test_stop_on_leak] && \
                  [string is boolean -strict $::test_stop_on_leak] && \
                  $::test_stop_on_leak}]
  }

  proc isExitOnComplete {} {
    return [expr {[info exists ::test_exit_on_complete] && \
                  [string is boolean -strict $::test_exit_on_complete] && \
                  $::test_exit_on_complete}]
  }

  proc returnInfoScript {} {
    return [info script]
  }

  proc runTestPrologue {} {
    #
    # NOTE: Verify that the global test path variable is available.
    #
    if {![info exists ::test_path]} then {
      error "cannot run test prologue, \"::test_path\" must be set"
    }

    #
    # HACK: We do not want to force every third-party test suite
    #       to come up with a half-baked solution to finding its
    #       own files.
    #
    if {![info exists ::no(prologue.eagle)] && ![info exists ::path]} then {
      set ::path [file normalize [file dirname [info script]]]
    }

    #
    # NOTE: Evaluate the standard test prologue in the context of
    #       the caller.
    #
    uplevel 1 [list source [file join $::test_path prologue.eagle]]
  }

  proc runTestEpilogue {} {
    #
    # NOTE: Verify that the global test path variable is available.
    #
    if {![info exists ::test_path]} then {
      error "cannot run test epilogue, \"::test_path\" must be set"
    }

    #
    # NOTE: Evaluate the standard test epilogue in the context of
    #       the caller.
    #
    uplevel 1 [list source [file join $::test_path epilogue.eagle]]

    #
    # HACK: We do not want to force every third-party test suite
    #       to come up with a half-baked solution to finding its
    #       own files.
    #
    if {![info exists ::no(epilogue.eagle)] && [info exists ::path]} then {
      unset ::path
    }
  }

  proc hookPuts {} {
    #
    # NOTE: This code was stolen from "tcltest" and heavily modified to
    #       work with Eagle.
    #
    proc [namespace current]::testPuts { args } {
      switch [llength $args] {
        1 {
          #
          # NOTE: Only the string to be printed is specified (stdout).
          #
          return [tputs $::test_channel [appendArgs [lindex $args 0] \n]]
        }
        2 {
          #
          # NOTE: Either -nonewline or channelId has been specified.
          #
          if {[lindex $args 0] eq "-nonewline"} then {
            return [tputs $::test_channel [lindex $args end]]
          } else {
            set channel [lindex $args 0]
            set newLine \n
          }
        }
        3 {
          #
          # NOTE: Both -nonewline and channelId are specified, unless
          #       it's an error.  The -nonewline option is supposed to
          #       be argv[0].
          #
          if {[lindex $args 0] eq "-nonewline"} then {
            set channel [lindex $args 1]
            set newLine ""
          }
        }
      }

      if {[info exists channel] && $channel eq "stdout"} then {
        #
        # NOTE: Write output for stdout to the test channel.
        #
        return [tputs $::test_channel [appendArgs [lindex $args end] \
            $newLine]]
      }

      #
      # NOTE: If we haven't returned by now, we don't know how to
      #       handle the input.  Let puts handle it.
      #
      return [eval ::tcl::save::puts $args]
    }

    rename ::puts ::tcl::save::puts; # save Tcl command
    rename [namespace current]::testPuts ::puts; # insert our proc
  }

  proc unhookPuts {} {
    rename ::puts ""; # remove our proc
    rename ::tcl::save::puts ::puts; # restore Tcl command
  }

  proc runTest { script } {
    #
    # NOTE: This should work properly in both Tcl and Eagle as long as the
    #       "init" script has been evaluated first.
    #
    if {![isEagle]} then {
      hookPuts
    }

    set code [catch {uplevel 1 $script} result]
    set error [expr {$code == 0 ? false : true}]

    if {[isEagle]} then {
      #
      # NOTE: Initially, the call to [tresult] (i.e. [host result]) will
      #       use the actual return code from the test command; however,
      #       if that return code was 3 (i.e. break), that indicates the
      #       test results should be highlighted in yellow -AND- that the
      #       test should still be considered successful even though the
      #       test was skipped.  If the return code was 4 (i.e. continue),
      #       that indicates the test results should be highlighted in
      #       dark yellow -AND- that the test should still be considered
      #       successful because failures are being ignored for it.
      #
      set tresultCode $code

      if {$code == 3} then {
        set code 0; set error false
      } elseif {$code == 4} then {
        set code 0
      }

      #
      # NOTE: If the return code from the test command indicates success
      #       and the test results contain a clear indication of failure,
      #       reset both return codes to indicate that failure.
      #
      if {$code == 0 && [regexp -- {\s==== (.*?) FAILED\s} $result]} then {
        set code 1; set tresultCode $code
      }

      #
      # NOTE: Display and/or log the results for the test that we just
      #       completed.
      #
      if {[shouldWriteTestData $code]} then {
        tresult $tresultCode $result
      } else {
        tlog $result
      }

      #
      # NOTE: If the test failed with an actual error (i.e. not just a
      #       test failure), make sure we do not obscure the error
      #       message with test suite output.
      #
      if {$error} then {
        tputs $::test_channel \n; # emit a blank line.
      }

      #
      # NOTE: If this test failed and the stop-on-failure flag is set,
      #       raise an error now.  If we are being run from inside
      #       runAllTests, this will also serve to signal it to stop
      #       processing further test files.
      #
      if {$code != 0 && [isStopOnFailure]} then {
        tresult Error "OVERALL RESULT: STOP-ON-FAILURE\n"

        unset -nocomplain ::test_suite_running
        error ""; # no message
      }

      #
      # NOTE: Unless forbidden from doing so, attempt to automatically
      #       cleanup any stale (e.g. temporary) object references now.
      #
      if {![info exists ::no(cleanupReferences)]} then {
        catch {object cleanup -references}
      }
    } else {
      if {$error} then {
        #
        # HACK: Prevent spurious errors dealing with [test] command options
        #       that are missing from native Tcl.
        #
        set badOptionPattern {^bad option ".*?":\
            must be -body, -cleanup, -constraints, -errorOutput,\
            -match, -output, -result, -returnCodes, or -setup$}

        set badMatchValuePattern {^bad -match value ".*?": must be\
            exact, glob, or regexp$}

        if {[isEagle] || \
            (![regexp -- $badOptionPattern $result] && \
             ![regexp -- $badMatchValuePattern $result])} then {
          tputs $::test_channel [appendArgs \
              "ERROR (runTest): " $result \n]
        }
      }

      unhookPuts
    }
  }

  proc testShim { args } {
    #
    # NOTE: Call the original (saved) [test] command, wrapping it in
    #       our standard test wrapper.
    #
    uplevel 1 [list runTest [concat ::savedTest $args]]
  }

  proc tsource { fileName {prologue true} {epilogue true} } {
    #
    # NOTE: Run the test prologue in the context of the caller (which
    #       must be global)?
    #
    if {$prologue} then {
      uplevel 1 runTestPrologue
    }

    #
    # NOTE: Save the original [test] command and setup our test shim in
    #       its place.
    #
    rename ::test ::savedTest
    interp alias {} ::test {} testShim

    #
    # NOTE: Source the specified test file in the context of the caller
    #       (which should be global).
    #
    set code [catch {uplevel 1 [list source $fileName]} result]
    set error [expr {$code == 0 ? false : true}]

    #
    # NOTE: Remove our test shim and restore the original (saved) [test]
    #       command.
    #
    interp alias {} ::test {}
    rename ::savedTest ::test

    #
    # NOTE: Run the test epilogue in the context of the caller (which
    #       must be global)?
    #
    if {$epilogue} then {
      uplevel 1 runTestEpilogue
    }

    #
    # NOTE: If the test raised an error, re-raise it now; otherwise,
    #       just return the result.
    #
    if {$error} then {
      unset -nocomplain ::test_suite_running
      error $result
    } else {
      return $result
    }
  }

  proc recordTestStatistics { varName index } {
    #
    # NOTE: Record counts of all object types that we track.
    #
    upvar 1 $varName array

    ###########################################################################

    if {![info exists array(uncounted,$index)]} then {
      set array(uncounted,$index) [getTestUncountedLeaks]
    }

    ###########################################################################

    set array(time,$index) [clock seconds]
    set array(afters,$index) [llength [after info]]
    set array(variables,$index) [llength [info globals]]
    set array(commands,$index) [llength [info commands]]
    set array(procedures,$index) [llength [info procs]]
    set array(namespaces,$index) [llength [namespace children ::]]

    ###########################################################################

    if {[info exists ::test_path]} then {
      set array(files,$index) [llength [getFiles $::test_path *]]
    } else {
      set array(files,$index) 0; # NOTE: Information not available.
    }

    ###########################################################################

    set array(temporaryFiles,$index) [llength [getFiles [getTemporaryPath] *]]
    set array(channels,$index) [llength [file channels]]
    set array(aliases,$index) [llength [interp aliases]]
    set array(interpreters,$index) [llength [interp slaves]]
    set array(environment,$index) [llength [array names env]]
    set array(loaded,$index) [llength [info loaded]]

    ###########################################################################

    #
    # NOTE: These native resource types cannot be positively checked
    #       for leaks (i.e. because the "leak" may be from an external
    #       process).
    #
    if {![info exists ::no(uncountedTemporaryFiles)]} then {
      lappend array(uncounted,$index) temporaryFiles
    }

    ###########################################################################

    if {[isEagle]} then {
      #
      # NOTE: Support for some of all of these entity types may not be
      #       present in the interpreter, initialize all these counts
      #       to zero and then try to query each one individually below
      #       wrapped in a catch.
      #
      set array(previousPid,$index) 0
      set array(scopes,$index) 0
      set array(assemblies,$index) 0
      set array(processes,$index) 0
      set array(objects,$index) 0
      set array(objectCallbacks,$index) 0
      set array(objectTypes,$index) 0
      set array(objectInterfaces,$index) 0
      set array(objectNamespaces,$index) 0

      catch {set array(previousPid,$index) [expr {[info previouspid] != 0}]}
      catch {set array(scopes,$index) [llength [scope list]]}
      catch {set array(assemblies,$index) [llength [object assemblies]]}
      catch {set array(processes,$index) [llength [getProcesses ""]]}
      catch {set array(objects,$index) [llength [info objects]]}
      catch {set array(objectCallbacks,$index) [llength [info callbacks]]}
      catch {set array(objectTypes,$index) [llength [object types]]}
      catch {set array(objectInterfaces,$index) [llength [object interfaces]]}
      catch {set array(objectNamespaces,$index) [llength [object namespaces]]}

      #########################################################################

      #
      # NOTE: Support for some of all of these entity types may not be
      #       present in the interpreter, initialize all these counts
      #       to zero and then try to query each one individually below
      #       wrapped in a catch.
      #
      set array(connections,$index) 0
      set array(transactions,$index) 0
      set array(modules,$index) 0
      set array(delegates,$index) 0
      set array(tcl,$index) 0
      set array(tclInterps,$index) 0
      set array(tclThreads,$index) 0
      set array(tclCommands,$index) 0
      set array(scriptThreads,$index) 0

      catch {set array(connections,$index) [llength [info connections]]}
      catch {set array(transactions,$index) [llength [info transactions]]}
      catch {set array(modules,$index) [llength [info modules]]}
      catch {set array(delegates,$index) [llength [info delegates]]}

      if {[llength [info commands tcl]] > 0} then {
        catch {set array(tcl,$index) [tcl ready]}
        catch {set array(tclInterps,$index) [llength [tcl interps]]}
        catch {set array(tclThreads,$index) [llength [tcl threads]]}
        catch {set array(tclCommands,$index) [llength [tcl command list]]}
      }

      #
      # NOTE: Grab the number of active threads that are active because
      #       of ScriptThread object instances.  This only works if Eagle
      #       is Beta 31 or higher.
      #
      catch {
        set array(scriptThreads,$index) \
            [object invoke -flags +NonPublic ScriptThread activeCount]
      }

      #########################################################################

      #
      # NOTE: These managed resource types cannot be positively checked
      #       for leaks (i.e. because the "leak" may be from an external
      #       process).
      #
      if {![info exists ::no(uncountedAssemblies)]} then {
        lappend array(uncounted,$index) assemblies
      }

      if {![info exists ::no(uncountedProcesses)]} then {
        lappend array(uncounted,$index) processes
      }
    }
  }

  proc reportTestStatistics {
          channel fileName stop statsVarName filesVarName } {
    set statistics [list afters variables commands procedures namespaces \
        files temporaryFiles channels aliases interpreters environment \
        loaded]

    if {[isEagle]} then {
      #
      # TODO: For now, tracking "leaked" assemblies is meaningless because
      #       the .NET Framework has no way to unload them without tearing
      #       down the entire application domain.
      #
      lappend statistics \
          previousPid scopes assemblies processes objects objectCallbacks \
          objectTypes objectInterfaces objectNamespaces connections \
          transactions modules delegates tcl tclInterps tclThreads \
          tclCommands scriptThreads
    }

    #
    # NOTE: Show what leaked, if anything.
    #
    set count 0; upvar 1 $statsVarName array

    foreach statistic $statistics {
      if {![info exists array($statistic,after)]} then {
        tputs $channel [appendArgs "==== \"" $fileName "\" MISSING " \
            $statistic " AFTER\n"]

        continue
      }

      if {![info exists array($statistic,before)]} then {
        tputs $channel [appendArgs "==== \"" $fileName "\" MISSING " \
            $statistic " BEFORE\n"]

        continue
      }

      if {$array($statistic,after) > $array($statistic,before)} then {
        lappend array(statistics,leaked) $statistic

        tputs $channel [appendArgs "==== \"" $fileName "\" LEAKED " \
            $statistic \n]

        if {[info exists array($statistic,before,list)]} then {
          tputs $channel [appendArgs "---- " $statistic " BEFORE: " \
              [formatList $array($statistic,before,list)] \n]
        }

        if {[info exists array($statistic,after,list)]} then {
          tputs $channel [appendArgs "---- " $statistic " AFTER: " \
              [formatList $array($statistic,after,list)] \n]
        }

        if {[info exists array(uncounted,before)] && \
            [lsearch -exact $array(uncounted,before) $statistic] != -1} then {
          continue
        }

        if {[info exists array(uncounted,after)] && \
            [lsearch -exact $array(uncounted,after) $statistic] != -1} then {
          continue
        }

        incr count
      }
    }

    #
    # NOTE: Make sure this file name is recorded in the list of file names with
    #       leaking tests.
    #
    upvar 1 $filesVarName fileNames

    if {$count > 0 && \
        [lsearch -exact $fileNames [file tail $fileName]] == -1} then {
      lappend fileNames [file tail $fileName]
    }

    #
    # NOTE: If we are supposed to stop or break into the debugger whenever
    #       a leak is detected, do it now.
    #
    if {$count > 0} then {
      #
      # BUGFIX: Is we are already stopping (e.g. due to a test failure), do
      #         not try to stop again.
      #
      if {!$stop && [isStopOnLeak]} then {
        tresult Error "OVERALL RESULT: STOP-ON-LEAK\n"

        unset -nocomplain ::test_suite_running
        error ""; # no message
      } elseif {[isBreakOnLeak]} then {
        testDebugBreak
      }
    }
  }

  proc formatList { list {default ""} {columns 1} } {
    if {[catch {
      set result ""
      set count 1

      foreach item $list {
        if {[incr count -1] == 0} then {
          set count $columns
          append result \n
        }

        append result \t

        if {[string length $item] > 0} then {
          append result $item
        } else {
          append result <noItem>
        }
      }
    }] == 0} then {
      return [expr {[string length $result] > 0 ? $result : $default}]
    } else {
      return ""
    }
  }

  proc formatListAsDict { list {default ""} } {
    if {[catch {
      set result ""

      foreach {name value} $list {
        append result \n\t

        if {[string length $name] > 0} then {
          append result $name
        } else {
          append result <noName>
        }

        append result ": "

        if {[string length $value] > 0} then {
          append result $value
        } else {
          append result <noValue>
        }
      }
    }] == 0} then {
      return [expr {[string length $result] > 0 ? $result : $default}]
    } else {
      return ""
    }
  }

  proc pathToRegexp { path {list false} } {
    #
    # NOTE: This procedure needs to escape all characters that
    #       have any special meaning to the regular expression
    #       engine.  Typically, the only characters we need to
    #       really worry about are the directory separator and
    #       the file extension separator (e.g. backslash and
    #       period on Windows and/or forward slash and period
    #       on Unix).  Since the forward slash has no special
    #       meaning to the regular expression engine, Windows
    #       is somewhat more difficult to handle.
    #
    set map [list \
        \\ \\\\ \$ \\\$ ( \\( ) \\) * \\* + \\+ - \\- . \\. \
        ? \\? \[ \\\[ \] \\\] ^ \\^ \{ \\\{ \} \\\}]

    return [string map $map [expr {$list ? [list $path] : $path}]]
  }

  proc assemblyNameToRegexp { assemblyName {list false} } {
    #
    # NOTE: This procedure needs to escape all characters that
    #       have any special meaning to the regular expression
    #       engine -AND- that can actually appear in a legal
    #       assembly name.  Normally, this would only include
    #       the period character.
    #
    # HACK: For now, just abuse the [pathToRegexp] procedure
    #       for this.
    #
    return [pathToRegexp $assemblyName $list]
  }

  proc inverseLsearchGlob { noCase patterns element } {
    #
    # NOTE: Perform the inverse of [lsearch -glob], attempt
    #       to match an element against a list of patterns.
    #
    set command [list string match]
    if {$noCase} then {lappend command -nocase}

    set length [llength $patterns]

    for {set index 0} {$index < $length} {incr index} {
      set pattern [lindex $patterns $index]

      if {[eval $command [list $pattern] [list $element]]} then {
        return $index
      }
    }

    return -1
  }

  proc removePathFromFileNames { path fileNames } {
    set result [list]

    foreach fileName $fileNames {
      if {[file normalize [file dirname $fileName]] eq \
          [file normalize $path]} then {
        #
        # NOTE: Strip the path name from this file name.
        #
        lappend result [file tail $fileName]
      } else {
        lappend result $fileName
      }
    }

    return $result
  }

  proc formatDecimal { value {places 4} {zeros false} } {
    #
    # NOTE: If the value is an empty string, do nothing and return an empty
    #       string.
    #
    if {[string length $value] == 0} then {
      return ""
    }

    #
    # NOTE: For now, use slightly different methods for formatting floating
    #       pointer numbers for native Tcl and Eagle.
    #
    if {[isEagle] && [llength [info commands object]] > 0} then {
      #
      # HACK: This works; however, in order to do this kind of thing cleanly,
      #       we really need the Tcl [format] command.
      #
      set result [object invoke String Format [appendArgs "{0:0." \
          [string repeat [expr {$zeros ? "0" : "#"}] $places] "}"] \
          [set object [object invoke -create Double Parse $value]]]

      unset object; # dispose
    } else {
      #
      # NOTE: See, nice and clean when done in Tcl?
      #
      set result [format [appendArgs %. $places f] $value]

      #
      # HACK: Since native Tcl does not appear to expose a method to only
      #       preserve non-zero trailing digits, we may need to manually
      #       remove extra trailing zeros.
      #
      if {!$zeros} then {
        #
        # NOTE: Remove all trailing zeros and the trailing decimal point,
        #       if necessary.
        #
        set result [string trimright [string trimright $result 0] .]
      }
    }

    return $result
  }

  proc clearTestPercent { channel } {
    if {[isEagle]} then {
      host title ""
    }
  }

  proc reportTestPercent {
          channel percent doneFiles totalFiles failedFiles leakedFiles } {
    if {[isEagle]} then {
      set totalTests $::eagle_tests(Total)
      set failedTests $::eagle_tests(Failed)
      set skippedTests $::eagle_tests(Skipped)
    } else {
      set totalTests $::tcltest::numTests(Total)
      set failedTests $::tcltest::numTests(Failed)
      set skippedTests $::tcltest::numTests(Skipped)
    }

    set status [appendArgs \
        "---- test suite running, about " $percent "% complete (" \
        $totalTests " tests total, " $failedTests " tests failed, " \
        $skippedTests " tests skipped, " $doneFiles " files done, " \
        $totalFiles " files total, " $failedFiles " files failed, " \
        $leakedFiles " files leaked)..."]

    tputs $channel [appendArgs $status \n]

    if {[isEagle]} then {
      host title $status
    }
  }

  proc reportArrayGet { varName } {
    if {[string length $varName] == 0} then {
      return [list]
    }

    upvar 1 $varName array

    if {![info exists ::no(reportArrayGet)]} then {
      set list(1) [list]

      foreach {name value} [array get array] {
        lappend list(1) [list $name $value]
      }

      #
      # HACK: This assumes that we are dealing with integer values.
      #
      set list(2) [lsort -index 1 -integer -decreasing $list(1)]
      set list(3) [list]

      foreach pair $list(2) {
        lappend list(3) [lindex $pair 0] [lindex $pair 1]
      }

      return $list(3)
    } else {
      return [array get array]
    }
  }

  proc reportTestStatisticCounts { channel statsVarName } {
    upvar 1 $statsVarName array

    #
    # NOTE: Were any counts recorded during the testing?
    #
    if {[info exists array(statistics,leaked)]} then {
      #
      # NOTE: Process each leak type in the list, recording any duplicates
      #       in the temporary count array.
      #
      foreach statistic $array(statistics,leaked) {
        if {[info exists count($statistic)]} then {
          incr count($statistic)
        } else {
          set count($statistic) 1
        }
      }

      #
      # NOTE: Flatten the temporary count array into a dictionary formatted
      #       list and then possibly display it (i.e. if it actually contains
      #       any data).
      #
      set statistics [reportArrayGet count]

      if {[llength statistics] > 0} then {
        tputs $channel [appendArgs "---- types of leaks detected: " \
            [formatListAsDict $statistics] \n]
      }
    }
  }

  proc runAllTests {
          channel path fileNames skipFileNames startFileNames stopFileNames } {
    #
    # NOTE: Are we configured to run the test files in random order?
    #
    if {[isRandomOrder]} then {
      set fileNames [lshuffle $fileNames]
    }

    #
    # NOTE: Show the exact arguments we received since they may not
    #       have been displayed by the caller (or anybody else).
    #
    if {![info exists ::no(runMetadata)]} then {
      tputs $channel [appendArgs "---- test run path: \"" $path \"\n]

      tputs $channel [appendArgs "---- test run file names: " \
          [formatList [removePathFromFileNames $path $fileNames]] \n]

      tputs $channel [appendArgs "---- test run skip file names: " \
          [formatList $skipFileNames] \n]
    }

    #
    # NOTE: Keep going unless this becomes true (i.e. if one of the
    #       test files signals us to stop).
    #
    set stop false

    #
    # NOTE: So far, we have run no tests.
    #
    set count 0

    #
    # NOTE: So far, no files have had failing or leaking tests.
    #
    set failed [list]
    set leaked [list]

    #
    # NOTE: Process each file name we have been given by the caller...
    #
    set total [llength $fileNames]; set lastPercent -1

    foreach fileName $fileNames {
      #
      # NOTE: If configured to break into the debugger before running the
      #       test file, do it now.
      #
      if {[isBreakOnDemand]} then {
        testDebugBreak
      }

      #
      # NOTE: In terms of files, not tests, what percent done are we now?
      #
      set percent [formatDecimal \
          [expr {$total != 0 ? 100.0 * ($count / double($total)) : 0}]]

      if {$percent != $lastPercent} then {
        if {![info exists ::no(runPercent)]} then {
          reportTestPercent $channel $percent \
              $count $total [llength $failed] [llength $leaked]
        }

        set lastPercent $percent
      }

      #
      # NOTE: If the starting file names have been specified by the caller,
      #       skip over all the file names before one of them.
      #
      if {[llength $startFileNames] > 0} then {
        if {[inverseLsearchGlob false $startFileNames \
            [file tail $fileName]] != -1} then {
          #
          # NOTE: Now that we found the starting test file name, do not
          #       skip any more test files.
          #
          set startFileNames [list]
        } else {
          #
          # NOTE: We have not found the starting test file name yet, skip
          #       over this test file.
          #
          continue
        }
      }

      #
      # NOTE: If the stopping file names have been specified by the caller,
      #       skip over all the file names after one of them.
      #
      if {[llength $stopFileNames] > 0} then {
        if {[inverseLsearchGlob false $stopFileNames \
            [file tail $fileName]] != -1} then {
          #
          # NOTE: Now that we found the stopping test file name, do not
          #       run any more test files.
          #
          set stopFileNames [list]

          #
          # NOTE: This will terminate the loop right after the test file
          #       cleanup code (i.e. at the bottom of the loop).
          #
          set stop true
        }
      }

      #
      # NOTE: Skipping over any file name that matches a pattern in the
      #       list of file names to skip.
      #
      if {[inverseLsearchGlob false $skipFileNames \
          [file tail $fileName]] == -1} then {
        #
        # NOTE: Does the file name contain directory information?
        #
        if {[string length [file dirname $fileName]] <= 1} then {
          #
          # NOTE: If not, assume it is under the supplied test path.
          #
          set fileName [file join $path $fileName]
        }

        #
        # NOTE: The "magic" pattern we are looking for to determine if
        #       a given file is part of the formal test suite.
        #
        set pattern {^(\s)*runTest .*$}

        #
        # NOTE: Skip files that are not part of the test suite.
        #
        set data [readFile $fileName]

        #
        # NOTE: Check for a match.
        #
        set match [regexp -line -- $pattern $data]

        #
        # NOTE: Failing that, in Eagle only, check if the data, when
        #       interpreted as Unicode, matches the pattern.
        #
        if {!$match && [isEagle]} then {
          set match [regexp -line -- $pattern \
              [encoding convertfrom unicode $data]]
        }

        #
        # NOTE: Does this "look" like an actual test suite file?
        #
        if {$match} then {
          #
          # BUGFIX: Unset the current test file name so that variable
          #         accounting works correctly.  It will be reset below
          #         prior to running any actual test(s).
          #
          unset -nocomplain ::test_file

          #
          # NOTE: Is resource leak checking explicitly disabled?
          #
          if {![info exists ::no(leak)]} then {
            #
            # NOTE: Get "before" resource counts for leak tracking.
            #
            recordTestStatistics leaks before
          }

          #
          # NOTE: Let the test prologue code know which file we are
          #       evaluating.
          #
          set ::test_file $fileName

          #
          # NOTE: Record failed test count before this file.
          #
          if {[isEagle]} then {
            set before $::eagle_tests(Failed)
          } else {
            set before $::tcltest::numTests(Failed)
          }

          #
          # NOTE: Evaluate the test file, optionally waiting for a certain
          #       number of milliseconds before and/or after doing so.
          #
          if {[catch {
            #
            # NOTE: Are we being prevented from waiting before the file?
            #
            if {![info exists ::no(preWait)]} then {
              if {[info exists ::test_wait(pre)] && \
                  [string is integer -strict $::test_wait(pre)]} then {
                if {![info exists ::no(runMetadata)]} then {
                  tputs $channel [appendArgs \
                      "---- waiting for " $::test_wait(pre) \
                      " milliseconds before test file...\n"]
                }

                after $::test_wait(pre); # NOTE: Sleep.
              }
            }

            #
            # NOTE: Log that this test file has started.
            #
            if {![info exists ::no(runStartFile)]} then {
              tputs $channel [appendArgs "==== \"" $fileName "\" START\n"]
            }

            #
            # NOTE: Evaluate the file in the context of the caller,
            #       catching any errors.  If an error is raised and
            #       the stop-on-failure flag is set, assume it was
            #       a test failure and that we need to stop any and
            #       all further processing of test files.
            #
            uplevel 1 [list source $fileName]

            #
            # NOTE: Log that this test file has ended.
            #
            if {![info exists ::no(runEndFile)]} then {
              tputs $channel [appendArgs "==== \"" $fileName "\" END\n"]
            }

            #
            # NOTE: Are we being prevented from waiting after the file?
            #
            if {![info exists ::no(postWait)]} then {
              if {[info exists ::test_wait(post)] && \
                  [string is integer -strict $::test_wait(post)]} then {
                if {![info exists ::no(runMetadata)]} then {
                  tputs $channel [appendArgs \
                      "---- waiting for " $::test_wait(post) \
                      " milliseconds after test file...\n"]
                }

                after $::test_wait(post); # NOTE: Sleep.
              }
            }
          } error]} then {
            #
            # NOTE: Most likely, this error was caused by malformed or
            #       incorrect code in-between the tests themselves.  We
            #       need to report this.
            #
            if {![info exists ::no(runErrorFile)]} then {
              tputs $channel [appendArgs "==== \"" $fileName "\" ERROR \"" \
                  $error \"\n]
            }

            #
            # NOTE: Stop further processing after this loop iteration?
            #
            if {[isStopOnFailure]} then {
              #
              # NOTE: This will terminate the loop right after the test
              #       file cleanup code (i.e. at the bottom of the loop).
              #
              set stop true

              #
              # BUGFIX: If there are no actual test failures recorded yet,
              #         make sure there is one now.  This is necessary to
              #         handle the case where an error occurs in a test
              #         file that does not directly cause at least one of
              #         its contained tests to fail.  Otherwise, the test
              #         suite will still be stopped; however, an overall
              #         result of success will be returned by the process.
              #
              if {[isEagle]} then {
                if {$::eagle_tests(Failed) == 0} then {
                  incr ::eagle_tests(Total)
                  incr ::eagle_tests(Failed)
                }
              } else {
                if {$::tcltest::numTests(Failed) == 0} then {
                  incr ::tcltest::numTests(Total)
                  incr ::tcltest::numTests(Failed)
                }
              }
            } else {
              #
              # NOTE: At this point, we know the test file had an error that
              #       probably caused it to skip a bunch of tests -AND- the
              #       option to stop-testing-on-error is not enabled.  That
              #       being said, we must not simply ignore the error.  The
              #       overall results of the test suite run must now reflect
              #       the failure.  Set a special variable for the epilogue
              #       to pick up on (later).
              #
              lappend ::test_suite_errors [list $fileName $error]
            }
          }

          #
          # NOTE: Record failed test count after this file.
          #
          if {[isEagle]} then {
            set after $::eagle_tests(Failed)
          } else {
            set after $::tcltest::numTests(Failed)
          }

          #
          # NOTE: Did this file have any failing tests?
          #
          if {$after > $before} then {
            lappend failed [file tail $fileName]
          }

          #
          # NOTE: In terms of files, not tests, what percent done are we now?
          #
          set percent [formatDecimal \
              [expr {$total != 0 ? 100.0 * ($count / double($total)) : 0}]]

          if {$percent != $lastPercent} then {
            if {![info exists ::no(runPercent)]} then {
              reportTestPercent $channel $percent \
                  $count $total [llength $failed] [llength $leaked]
            }

            set lastPercent $percent
          }

          #
          # NOTE: Unset the current test file name, it is no longer
          #       needed.
          #
          unset -nocomplain ::test_file

          #
          # NOTE: Is resource leak checking explicitly disabled?
          #
          if {![info exists ::no(leak)]} then {
            #
            # NOTE: Get "after" resource counts for leak tracking.
            #
            recordTestStatistics leaks after

            if {![info exists ::no(runStatistics)]} then {
              #
              # NOTE: Determine if any resource leaks have occurred and
              #       output diagnostics as necessary if they have.
              #
              reportTestStatistics $channel $fileName $stop leaks leaked
            }
          }
        } else {
          #
          # NOTE: This entire file has been skipped.  Record that fact in the
          #       test suite log file.
          #
          if {![info exists ::no(runNonTestFile)]} then {
            tputs $channel [appendArgs \
                "==== \"" $fileName "\" NON_TEST_FILE\n"]
          }
        }

        #
        # NOTE: Another file of some kind was processed.  It may have been
        #       skipped; however, that does not matter.
        #
        incr count

        #
        # NOTE: In terms of files, not tests, what percent done are we now?
        #
        set percent [formatDecimal \
            [expr {$total != 0 ? 100.0 * ($count / double($total)) : 0}]]

        if {$percent != $lastPercent} then {
          if {![info exists ::no(runPercent)]} then {
            reportTestPercent $channel $percent \
                $count $total [llength $failed] [llength $leaked]
          }

          set lastPercent $percent
        }

        #
        # NOTE: If the test file raised an error (i.e. to indicate a
        #       test failure with the stop-on-failure flag enabled),
        #       break out of the test loop now.
        #
        if {$stop} then {
          break
        }
      } else {
        #
        # NOTE: This entire file has been skipped.  Record that fact in the
        #       test suite log file.
        #
        if {![info exists ::no(runSkippedFile)]} then {
          tputs $channel [appendArgs "==== \"" $fileName "\" SKIPPED\n"]
        }

        #
        # NOTE: This file was skipped.
        #
        incr count
      }

      #
      # NOTE: In terms of files, not tests, what percent done are we now?
      #
      set percent [formatDecimal \
          [expr {$total != 0 ? 100.0 * ($count / double($total)) : 0}]]

      if {$percent != $lastPercent} then {
        if {![info exists ::no(runPercent)]} then {
          reportTestPercent $channel $percent \
              $count $total [llength $failed] [llength $leaked]
        }

        set lastPercent $percent
      }
    }

    #
    # NOTE: Reset the host title because we may have changed it in the for
    #       loop (above).
    #
    if {![info exists ::no(runPercent)]} then {
      clearTestPercent $channel
    }

    if {![info exists ::no(runMetadata)]} then {
      tputs $channel [appendArgs "---- sourced " $count " test " \
          [expr {$count > 1 ? "files" : "file"}] \n]

      #
      # NOTE: Show the files that had failing and/or leaking tests.
      #
      if {[llength $failed] > 0} then {
        tputs $channel [appendArgs "---- files with failing tests: " \
            [formatList $failed] \n]
      }

      if {[llength $leaked] > 0} then {
        tputs $channel [appendArgs "---- files with leaking tests: " \
            [formatList $leaked] \n]
      }
    }

    if {![info exists ::no(runStatisticCounts)]} then {
      reportTestStatisticCounts $channel leaks
    }
  }

  proc isTestSuiteRunning {} {
    #
    # NOTE: Return non-zero if the test suite appears to be running.
    #
    return [expr {[info exists ::test_suite_running] && \
        $::test_suite_running}]
  }

  proc getTestChannelOrDefault {} {
    if {[info exists ::test_channel]} then {
      return $::test_channel
    }

    return stdout; # TODO: Good default?
  }

  proc tryVerifyTestPath {} {
    #
    # NOTE: If the test path variable does not exist, the directory it
    #       points to does not exist (or is not really a directory), or
    #       it appears to be an empty directory, return false; otherwise,
    #       return true.
    #
    if {![info exists ::test_path] || \
        ![file exists $::test_path] || \
        ![file isdirectory $::test_path] || \
        [llength [getFiles $::test_path *]] == 0} then {
      return false
    }

    return true
  }

  proc checkForAndSetTestPath { whatIf {quiet false} } {
    #
    # NOTE: Everything in this procedure requires access to the file system;
    #       therefore, it cannot be used in a stock "safe" interpreter.
    #
    if {![interp issafe] && ![info exists ::test_path]} then {
      #
      # NOTE: Grab the name of the current script file.  If this is an empty
      #       string, many test path checks will have to be skipped.
      #
      set script [info script]

      #
      # NOTE: Eagle and native Tcl have different requirements and possible
      #       locations for the test path; therefore, handle them separately.
      #
      if {[isEagle]} then {
        #
        # NOTE: Grab the base directory and the library directory.  Without
        #       these, several test path checks will be skipped.
        #
        set library [getTestLibraryDirectory]; set base [info base]

        if {[string length $library] > 0} then {
          #
          # NOTE: Try the source release directory structure.  For this
          #       case, the final test path would be:
          #
          #           $library/../../Library/Tests
          #
          set ::test_path [file normalize [file join [file dirname [file \
              dirname $library]] Library Tests]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #1 for Eagle test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $base] > 0 && \
            ($whatIf || ![tryVerifyTestPath])} then {
          #
          # NOTE: Try the source release directory structure again; this
          #       time, assume only the embedded script library was used.
          #       For this case, the final test path would be:
          #
          #           $base/Library/Tests
          #
          set ::test_path [file normalize [file join $base Library Tests]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #2 for Eagle test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $script] > 0 && \
            ($whatIf || ![tryVerifyTestPath])} then {
          #
          # NOTE: Try for the test package directory.  For this case, the
          #       final test path would be:
          #
          #           $script/../Test1.0
          #
          set ::test_path [file normalize [file join [file dirname [file \
              dirname $script]] [appendArgs Test [info engine Version]]]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #3 for Eagle test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $base] > 0 && \
            ($whatIf || ![tryVerifyTestPath])} then {
          #
          # NOTE: Try for the test package directory again; this time, use
          #       the base path and assume the source release directory
          #       structure.  For this case, the final test path would be:
          #
          #           $base/lib/Test1.0
          #
          set ::test_path [file normalize [file join $base lib [appendArgs \
              Test [info engine Version]]]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #4 for Eagle test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $base] > 0 && \
            ($whatIf || ![tryVerifyTestPath])} then {
          #
          # NOTE: Try for the test package directory again; this time, use
          #       the base path.  For this case, the final test path would
          #       be:
          #
          #           $base/Test1.0
          #
          set ::test_path [file normalize [file join $base [appendArgs \
              Test [info engine Version]]]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #5 for Eagle test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $library] > 0 && \
            ($whatIf || ![tryVerifyTestPath])} then {
          #
          # NOTE: This must be a binary release, no "Library" directory
          #       then.  Also, binary releases have an upper-case "Tests"
          #       directory name that originates from the "update.bat"
          #       tool.  This must match the casing used in "update.bat".
          #       For this case, the final test path would be:
          #
          #           $library/../../Tests
          #
          set ::test_path [file normalize [file join [file dirname [file \
              dirname $library]] Tests]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #6 for Eagle test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $base] > 0 && \
            ($whatIf || ![tryVerifyTestPath])} then {
          #
          # NOTE: Fallback to using the base directory and checking for a
          #       "Tests" directory beneath it.  For this case, the final
          #       test path would be:
          #
          #           $base/Tests
          #
          set ::test_path [file normalize [file join $base Tests]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #7 for Eagle test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {!$quiet} then {
          tqputs [getTestChannelOrDefault] [appendArgs \
              "---- final Eagle test path is \"" \
              [expr {[info exists ::test_path] ? \
              $::test_path : "<none>"}] \"\n]
        }
      } else {
        if {[string length $script] > 0} then {
          #
          # NOTE: Try the source release directory structure.  For this
          #       case, the final test path would be:
          #
          #           $script/../../Library/Tests
          #
          set ::test_path [file normalize [file join [file dirname [file \
              dirname [file dirname $script]]] Library Tests]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #1 for Tcl test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $script] > 0 && \
            ($whatIf || ![tryVerifyTestPath])} then {
          #
          # NOTE: Try for the test package directory.  For this case, the
          #       final test path would be:
          #
          #           $script/../Test1.0
          #
          set ::test_path [file normalize [file join [file dirname [file \
              dirname $script]] Test1.0]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #2 for Tcl test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $script] > 0 && \
            ($whatIf || ![tryVerifyTestPath])} then {
          #
          # NOTE: This must be a binary release, no "Library" directory
          #       then.  Also, binary releases have an upper-case "Tests"
          #       directory name that originates from the "update.bat"
          #       tool.  This must match the casing used in "update.bat".
          #       For this case, the final test path would be:
          #
          #           $script/../../Tests
          #
          set ::test_path [file normalize [file join [file dirname [file \
              dirname [file dirname $script]]] Tests]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #3 for Tcl test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {!$quiet} then {
          tqputs [getTestChannelOrDefault] [appendArgs \
              "---- final Tcl test path is \"" \
              [expr {[info exists ::test_path] ? \
              $::test_path : "<none>"}] \"\n]
        }
      }
    }
  }

  proc configureTcltest { verbose match skip constraints imports force } {
    #
    # NOTE: Eagle and native Tcl have different configuration requirements
    #       for the "tcltest" package.  For Eagle, the necessary testing
    #       functionality is built-in.  In native Tcl, the package must be
    #       loaded now and that cannot be done in a "safe" interpreter.
    #
    if {[isEagle]} then {
      #
      # HACK: Flag the "test" and "runTest" script library procedures so
      #       that they use the script location of their caller and not
      #       their own.
      #
      # BUGBUG: Even this does not yet fix the script location issues in
      #         the test suite:
      #
      #         debug procedureflags test +ScriptLocation
      #         debug procedureflags runTest +ScriptLocation
      #
      # NOTE: Setup the necessary compatibility shims for the test suite.
      #
      namespace eval ::tcltest {}; # HACK: Force namespace creation now.
      setupTestShims true [expr {![isTestSuiteRunning]}]

      #
      # NOTE: Fake having the package as the functionality is built-in.
      #
      package provide tcltest 2.2.10; # Tcl 8.4
    } elseif {![interp issafe]} then {
      #
      # NOTE: Attempt to detect if the package is already loaded.
      #
      set loaded [expr {[catch {package present tcltest}] == 0}]

      #
      # NOTE: Always attempt to load the package.
      #
      package require tcltest

      #
      # NOTE: Configure it for our use (only when it was not loaded).
      #
      if {!$loaded} then {
        if {[string length $verbose] > 0} then {
          ::tcltest::configure -verbose $verbose
        } else {
          ::tcltest::configure -verbose pbste
        }
      }

      #
      # NOTE: We need to copy the Eagle test names to match over to Tcl.
      #
      if {[llength $match] > 0} then {
        ::tcltest::configure -match $match
      }

      #
      # NOTE: We need to copy the Eagle test names to skip over to Tcl.
      #
      if {[llength $skip] > 0} then {
        ::tcltest::configure -skip $skip
      }

      #
      # NOTE: We need to copy the Eagle test constraints over to Tcl.
      #
      if {[llength $constraints] > 0} then {
        ::tcltest::configure -constraints $constraints
      }

      #
      # NOTE: For the benefit of the Eagle test suite, always add the
      #       pseudo-constraints "fail.false" and "fail.true".
      #
      ::tcltest::testConstraint fail.false 1
      ::tcltest::testConstraint fail.true 1

      #
      # NOTE: We need the [test] command in the global namespace.
      #
      if {[llength $imports] > 0} then {
        set command [list namespace import]

        if {$force} then {
          lappend command -force
        }

        foreach import $imports {
          lappend command [appendArgs ::tcltest:: $import]
        }

        namespace eval :: $command
      }
    }
  }

  proc machineToPlatform { machine {architecture false} } {
    #
    # NOTE: Cannot use "-nocase" option here because Tcl 8.4 does not
    #       support it (i.e. because it is pre-TIP #241).
    #
    switch -exact -- [string tolower $machine] {
      intel {
        if {!$architecture && [isWindows]} then {
          return Win32
        } else {
          return x86
        }
      }
      arm {
        return arm
      }
      ia64 {
        return itanium
      }
      msil {
        return clr
      }
      amd64 {
        return x64
      }
      ia32_on_win64 {
        return wow64
      }
      arm64 {
        return arm64
      }
      default {
        return unknown
      }
    }
  }

  proc architectureForPlatform { platform } {
    #
    # NOTE: Cannot use "-nocase" option here because Tcl 8.4 does not
    #       support it (i.e. because it is pre-TIP #241).
    #
    switch -exact -- [string tolower $platform] {
      intel -
      win32 -
      x86 {
        return x86
      }
      arm {
        return arm
      }
      ia64 -
      itanium {
        return ia64
      }
      msil -
      clr {
        return msil
      }
      amd64 -
      x64 {
        return x64
      }
      ia32_on_win64 -
      wow64 {
        return ia32_on_win64
      }
      arm64 {
        return arm64
      }
      default {
        return unknown
      }
    }
  }

  if {[isEagle]} then {
    ###########################################################################
    ############################ BEGIN Eagle ONLY #############################
    ###########################################################################

    proc initializeTests {} {
      uplevel #0 {
        #
        # NOTE: Reset the information in the global "tests" array, which is
        #       used to interface with the internal test tracking information
        #       in the interpreter via a variable trace.
        #
        set eagle_tests(Total) 0
        set eagle_tests(Skipped) 0
        set eagle_tests(Passed) 0
        set eagle_tests(Failed) 0

        #
        # NOTE: Setup the lists of patterns to match test names against.  In
        #       Eagle, these originate from the command line arguments and are
        #       passed to the interpreter via this virtual array.
        #
        if {[info exists test_flags(-match)]} then {
          set eagle_tests(MatchNames) $test_flags(-match); # run these tests.
        } else {
          set eagle_tests(MatchNames) [list *]; # default to running all tests.
        }

        if {[info exists test_flags(-skip)]} then {
          set eagle_tests(SkipNames) $test_flags(-skip); # skip these tests.
        } else {
          set eagle_tests(SkipNames) [list]; # default to skipping no tests.
        }

        #
        # NOTE: What tests have been skipped, if any?
        #
        set eagle_tests(SkippedNames) [list]

        #
        # NOTE: What tests have failed, if any?
        #
        set eagle_tests(FailedNames) [list]

        #
        # NOTE: Initialize the list of active test constraints from the
        #       environment variable and/or the test flags.
        #
        set eagle_tests(Constraints) [getEnvironmentVariable testConstraints]

        if {[info exists test_flags(-constraints)]} then {
          eval lappend eagle_tests(Constraints) $test_flags(-constraints)
        }

        unset -nocomplain test_verbose
        set test_verbose [getEnvironmentVariable testVerbose]

        if {[string length $test_verbose] == 0} then {
          set test_verbose Default
        }

        if {[info exists test_flags(-verbose)] && \
            [string length $test_flags(-verbose)] > 0} then {
          #
          # NOTE: Map all test verbosity flags we support for script usage
          #       to their abbreviated names (which are all one letter) and
          #       then split them into a list.
          #
          set test_verbose [split [string map [list \
              Body B Pass P Skip S Start T Error E Line L \
              Fail F Reason R Time I Exit X StdOut O StdErr D] \
              $test_flags(-verbose)] ""]
        }

        set eagle_tests(Verbose) $test_verbose; unset test_verbose
      }
    }

    proc setupTestShims { setup {quiet false} } {
      if {$setup} then {
        #
        # HACK: Compatibility shim(s) for use with various tests in the Tcl
        #       test suite.  Make sure these commands do not already exist
        #       prior to attempt to adding them.
        #
        if {[llength [info commands testConstraint]] == 0} then {
          interp alias {} testConstraint {} haveOrAddConstraint

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] \
                "---- added \"testConstraint\" alias\n"
          }
        }

        if {[llength [info commands ::tcltest::testConstraint]] == 0} then {
          interp alias {} ::tcltest::testConstraint {} haveOrAddConstraint

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] \
                "---- added \"::tcltest::testConstraint\" alias\n"
          }
        }

        #
        # NOTE: This is needed by most tests in the Tcl test suite.  Make
        #       sure this command does not already exist prior to adding it.
        #
        if {[llength [info commands ::tcltest::cleanupTests]] == 0} then {
          proc ::tcltest::cleanupTests { args } {}

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] \
                "---- added \"::tcltest::cleanupTests\" procedure\n"
          }
        }

        #
        # NOTE: This is needed by some tests in the Tcl test suite.  Make
        #       sure this command does not already exist prior to adding it.
        #
        if {[llength [info commands \
            ::tcltest::loadTestedCommands]] == 0} then {
          proc ::tcltest::loadTestedCommands { args } {}

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] \
                "---- added \"::tcltest::loadTestedCommands\" procedure\n"
          }
        }
      } else {
        #
        # NOTE: Remove the compatibility shim command aliases that we setup
        #       earlier.
        #
        if {[llength [info commands \
            ::tcltest::loadTestedCommands]] > 0} then {
          rename ::tcltest::loadTestedCommands ""

          if {!$quiet} then {
            tqputs $::test_channel \
                "---- removed \"::tcltest::loadTestedCommands\" procedure\n"
          }
        }

        if {[llength [info commands ::tcltest::cleanupTests]] > 0} then {
          rename ::tcltest::cleanupTests ""

          if {!$quiet} then {
            tqputs $::test_channel \
                "---- removed \"::tcltest::cleanupTests\" procedure\n"
          }
        }

        if {[llength [interp aliases ::tcltest::testConstraint]] > 0} then {
          interp alias {} ::tcltest::testConstraint {} {}

          if {!$quiet} then {
            tqputs $::test_channel \
                "---- removed \"::tcltest::testConstraint\" alias\n"
          }
        }

        if {[llength [interp aliases testConstraint]] > 0} then {
          interp alias {} testConstraint {} {}

          if {!$quiet} then {
            tqputs $::test_channel \
                "---- removed \"testConstraint\" alias\n"
          }
        }
      }
    }

    proc shouldWriteTestData { code } {
      if {[llength [info commands object]] > 0 && [catch {
        object invoke -flags +NonPublic \
            Eagle._Components.Private.TestOps ShouldWriteTestData "" $code
      } writeTestData] == 0 && $writeTestData} then {
        return false
      }

      return true
    }

    proc tresult { code result } {
      host result $code $result; tlog $result
    }

    proc getPassPercentage {} {
      if {$::eagle_tests(Total) > 0} then {
        return [expr \
            {100.0 * (($::eagle_tests(Passed) + \
            $::eagle_tests(Skipped)) / \
            double($::eagle_tests(Total)))}]
      }

      return 0; # no tests were run, etc.
    }

    proc getSkipPercentage {} {
      if {$::eagle_tests(Total) > 0} then {
        return [expr \
            {100.0 * ($::eagle_tests(Skipped) / \
            double($::eagle_tests(Total)))}]
      }

      return 0; # no tests were run, etc.
    }

    proc createThread { script {parameterized false} {maxStackSize ""} } {
      if {[isDotNetCore]} then {
        #
        # HACK: This seems to make .NET Core happier for reasons
        #       that are not entirely clear.
        #
        set typeName "System.Threading.Thread, mscorlib"
      } else {
        set typeName System.Threading.Thread
      }

      if {$parameterized} then {
        if {[string length $maxStackSize] > 0} then {
          return [object create -alias -objectflags +NoReturnReference \
              -parametertypes System.Threading.ParameterizedThreadStart \
              $typeName $script $maxStackSize]
        } else {
          return [object create -alias -objectflags +NoReturnReference \
              -parametertypes System.Threading.ParameterizedThreadStart \
              $typeName $script]
        }
      } else {
        if {[string length $maxStackSize] > 0} then {
          return [object create -alias -objectflags +NoReturnReference \
              $typeName $script $maxStackSize]
        } else {
          return [object create -alias -objectflags +NoReturnReference \
              $typeName $script]
        }
      }
    }

    proc startThread { thread {parameterized false} {parameter null} } {
      if {$parameterized} then {
        $thread Start $parameter
      } else {
        $thread Start
      }
    }

    proc cleanupThread { thread {timeout 2000} } {
      if {[$thread IsAlive]} then {
        if {[catch {$thread Interrupt} error]} then {
          tputs $::test_channel [appendArgs \
              "---- failed to interrupt test thread \"" $thread "\": " \
              $error \n]
        } else {
          tputs $::test_channel [appendArgs "---- test thread \"" $thread \
              "\" interrupted\n"]
        }

        if {[$thread IsAlive]} then {
          if {[catch {$thread Join $timeout} error]} then {
            tputs $::test_channel [appendArgs \
                "---- failed to join test thread \"" $thread "\": " \
                $error \n]
          } elseif {$error} then {
            tputs $::test_channel [appendArgs "---- joined test thread \"" \
                $thread \"\n]
          } else {
            tputs $::test_channel [appendArgs \
                "---- timeout joining test thread \"" $thread " (" \
                $timeout " milliseconds)\"\n"]
          }

          if {[$thread IsAlive]} then {
            if {[catch {$thread Abort} error]} then {
              tputs $::test_channel [appendArgs \
                  "---- failed to abort test thread \"" $thread "\": " \
                  $error \n]
            } else {
              tputs $::test_channel [appendArgs "---- test thread \"" \
                  $thread "\" aborted\n"]
            }

            if {[$thread IsAlive]} then {
              tputs $::test_channel [appendArgs "---- test thread \"" \
                  $thread "\" appears to be a zombie\n"]
            } else {
              return true; # aborted?
            }
          } else {
            return true; # joined?
          }
        } else {
          return true; # interrupted?
        }
      } else {
        return true; # already dead?
      }

      return false; # still alive (or error).
    }

    proc reportTestConstraintCounts { channel skippedNames } {
      #
      # NOTE: Process the list of skipped tests, which is really a dictionary
      #       of test names to the list of constraints that caused them to be
      #       skipped.  We need to "roll them up", on a per-constraint basis,
      #       and produce counts for each constraint.  At the same time, we
      #       need to keep track of the maximum count seen, to help align the
      #       final output.
      #
      set maximum 0

      foreach {testName constraintNames} $skippedNames {
        foreach constraintName $constraintNames {
          if {[info exists skippedCounts($constraintName)]} then {
            incr skippedCounts($constraintName)
          } else {
            set skippedCounts($constraintName) 1
          }

          if {$skippedCounts($constraintName) > $maximum} then {
            set maximum $skippedCounts($constraintName)
          }
        }
      }

      #
      # NOTE: Produce the final output, which includes a single line header
      #       followed by one line per test constraint seen.
      #
      if {$maximum > 0 && [array size skippedCounts] > 0} then {
        set places [expr {int(log10($maximum)) + 1}]

        tputs $channel "Number of tests skipped for each constraint:\n"

        foreach {name value} [reportArrayGet skippedCounts] {
          tputs $channel [appendArgs \
              \t [format [appendArgs % $places s] $value] \t $name \n]
        }

        tputs $channel \n
      }
    }

    proc purgeAndCleanup { channel name } {
      catch {uplevel 1 [list debug purge]} result

      tputs $channel [appendArgs \
          "---- purge \"" $name "\" results: " $result \n]

      catch {uplevel 1 [list debug cleanup]} result

      tputs $channel [appendArgs \
          "---- cleanup \"" $name "\" results: " $result \n]

      catch {uplevel 1 [list object invoke -flags +NonPublic \
          Eagle._Components.Private.ProcessOps ClearOutputCache]} result

      tputs $channel [appendArgs \
          "---- ProcessOps cleanup results: " $result \n]

      catch {uplevel 1 [list object invoke -flags +NonPublic \
          Eagle._Components.Private.EnumOps ClearEnumCache]} result

      tputs $channel [appendArgs \
          "---- EnumOps cleanup results: " $result \n]

      catch {uplevel 1 [list object invoke -flags +NonPublic \
          Eagle._Components.Private.HelpOps ClearHelpCache]} result

      tputs $channel [appendArgs \
          "---- HelpOps cleanup results: " $result \n]

      catch {uplevel 1 [list object invoke -flags +NonPublic \
          Eagle._Components.Private.StringOps ClearPreambleEncodings]} result

      tputs $channel [appendArgs \
          "---- StringOps cleanup results: " $result \n]

      catch {uplevel 1 [list object invoke -flags +NonPublic \
          Eagle._Comparers.FileName ClearCache]} result

      tputs $channel [appendArgs \
          "---- Comparers.FileName cleanup results: " $result \n]

      catch {uplevel 1 [list object invoke -flags +NonPublic \
          Eagle._Components.Private.HashOps Cleanup]} result

      tputs $channel [appendArgs \
          "---- HashOps cleanup results: " $result \n]

      catch {uplevel 1 [list object invoke -flags +NonPublic \
          Eagle._Components.Private.FactoryOps Cleanup]} result

      tputs $channel [appendArgs \
          "---- FactoryOps cleanup results: " $result \n]
    }

    proc evalWithTimeout { script {milliseconds 2000} {resultVarName ""} } {
      #
      # NOTE: Verify that the number of milliseconds requested is greater than
      #       zero.
      #
      if {$milliseconds <= 0} then {
        error "number of milliseconds must be greater than zero"
      }

      #
      # NOTE: Force any [vwait] that may be in the contained script to stop
      #       when it hits the script cancellation, saving the preexisting
      #       event wait flags first for later restoration.
      #
      set savedEventWaitFlags [object invoke -flags +NonPublic \
          Interpreter.GetActive eventWaitFlags]

      object invoke -flags +NonPublic Interpreter.GetActive \
          eventWaitFlags [combineFlags $savedEventWaitFlags StopOnError]

      try {
        #
        # NOTE: Save the current [after] flags for later restoration and then
        #       reset them to process events immediately.
        #
        set flags [after flags]
        after flags =Immediate

        try {
          #
          # NOTE: Evaluate the specified script in the context of the caller,
          #       returning the result to the caller.
          #
          if {[string length $resultVarName] > 0} then {
            upvar 1 $resultVarName result
          }

          return [catch {
            #
            # NOTE: First, make sure that the [after] event queue for the
            #       interpreter is totally empty.
            #
            catch {foreach id [after info] {after cancel $id}}

            #
            # NOTE: Schedule the event to cancel the script we are about to
            #       evaluate, capturing the name so we can cancel it later,
            #       if necessary.
            #
            set event [after $milliseconds [list interp cancel]]

            #
            # NOTE: Evaluate the script in the context of the caller.
            #
            uplevel 1 $script
          } result]
        } finally {
          if {[info exists event]} then {
            catch {after cancel $event}
          }

          after flags [appendArgs = $flags]
        }
      } finally {
        if {[info exists savedEventWaitFlags]} then {
          object invoke -flags +NonPublic Interpreter.GetActive \
              eventWaitFlags $savedEventWaitFlags
        }
      }
    }

    proc vwaitWithTimeout { varName {milliseconds 2000} } {
      #
      # NOTE: Verify that the number of milliseconds requested is positive or
      #       zero.
      #
      if {$milliseconds < 0} then {
        error "number of milliseconds cannot be negative"
      }

      try {
        #
        # NOTE: Schedule the event to cancel the script we are about to
        #       evaluate, capturing the name so we can cancel it later,
        #       if necessary.
        #
        set event [after $milliseconds [list interp cancel]]

        if {[catch {
          #
          # NOTE: Refer to the specified variable in the context of our
          #       caller.
          #
          upvar 1 $varName variable

          #
          # NOTE: Wait for the variable to be changed -OR- for the wait
          #       to be canceled.
          #
          vwait -eventwaitflags {+NoBgError StopOnError} -- variable
        }] == 0} then {
          #
          # NOTE: The wait completed successfully, the variable should
          #       have been changed.
          #
          return true
        } else {
          #
          # NOTE: The wait did not complete, it may have been canceled
          #       and the variable may or may not have been changed.
          #
          return false
        }
      } finally {
        if {[info exists event]} then {
          catch {after cancel $event}
        }
      }
    }

    proc tclLoadForTest { {varName ""} {findFlags ""} {loadFlags ""} } {
      if {[string length $varName] > 0} then {
        upvar 1 $varName loaded
      }

      set loaded 0

      if {![tcl ready]} then {
        set command [list tcl load]

        if {[string length $findFlags] > 0} then {
          lappend command -findflags $findFlags
        }

        if {[string length $loadFlags] > 0} then {
          lappend command -loadflags $loadFlags
        }

        uplevel 1 $command; set loaded 1

        set module [tcl module]
        set interp [tcl master]

        tputs $::test_channel [appendArgs \
            "---- native Tcl loaded, module \"" $module \
            "\", interpreter \"" $interp \"\n]
      }
    }

    proc tclUnloadForTest { {force false} {varName ""} } {
      set unload false

      if {$force} then {
        #
        # NOTE: This cannot check [tcl ready] as some tests actually
        #       rely upon errors from the [tcl unload] sub-command.
        #
        set unload true
      }

      if {[string length $varName] > 0} then {
        upvar 1 $varName loaded

        if {$loaded && !$unload} then {
          set unload true
        }

        unset -nocomplain loaded
      }

      if {$unload} then {
        set module [tcl module]
        set interp [tcl master]

        uplevel 1 [list tcl unload]

        tputs $::test_channel [appendArgs \
            "---- native Tcl " [expr {$force ? "forcibly " : ""}] \
            "unloaded, module \"" $module "\", interpreter \"" \
            $interp \"\n]
      }
    }

    proc testExecTclScript { script {shell ""} {verbose false} } {
      try {
        #
        # NOTE: Get a temporary file name for the script we are going to
        #       use to query the machine type for the native Tcl shell.
        #
        set fileName [file tempname]

        #
        # NOTE: Since the native Tcl shell cannot simply evaluate a string
        #       supplied via the command line, write the script to be
        #       evaluated to the temporary file.
        #
        writeFile $fileName $script

        #
        # NOTE: Use the specified shell, if it is valid; otherwise, use
        #       the configured Tcl shell.
        #
        if {[string length $shell] == 0} then {
          #
          # NOTE: Before attempting to use the configured Tcl shell, make
          #       sure it has actually been set.
          #
          if {[info exists ::test_tclsh] && \
              [string length $::test_tclsh] > 0} then {
            #
            # NOTE: Use the currently configured Tcl shell, which may or
            #       may not actually exist.
            #
            set shell $::test_tclsh
          } else {
            #
            # NOTE: We cannot execute the native Tcl shell because one
            #       has not been specified, nor configured.
            #
            return [expr {$verbose ? "::test_tclsh missing" : "error"}]
          }
        }

        #
        # NOTE: Evaluate the script using the native Tcl shell, trim the
        #       excess whitespace from the output, and return it to the
        #       caller.
        #
        if {[catch {string trim \
            [testExec $shell [list -success Success] \
            [appendArgs \" $fileName \"]]} result] == 0} then {
          #
          # NOTE: Success, return the result to the caller.
          #
          return $result
        } else {
          #
          # NOTE: We could not execute the native Tcl shell (perhaps one
          #       is not available?).
          #
          return [expr {$verbose ? [appendArgs "error: " $result] : "error"}]
        }
      } finally {
        #
        # NOTE: Should we delete the temporary file we created, if any?
        #
        if {![info exists ::no(deleteTestExecTclFile)]} then {
          #
          # NOTE: Did we create a temporary file to hold the Tcl script?
          #
          if {[info exists fileName] && \
              [string length $fileName] > 0 && \
              [file exists $fileName]} then {
            #
            # NOTE: Delete the temporary file we used to query the machine
            #       type for the native Tcl shell.
            #
            catch {file delete $fileName}
          }
        }
      }
    }

    proc getTclVersionForTclShell { {shell ""} } {
      return [testExecTclScript {
        puts -nonewline stdout [info tclversion]
      } $shell]
    }

    proc getCommandsForTclShell { {shell ""} } {
      return [testExecTclScript {
        puts -nonewline stdout [info commands]
      } $shell]
    }

    proc getMachineForTclShell { {shell ""} } {
      return [testExecTclScript {
        puts -nonewline stdout $tcl_platform(machine)
      } $shell]
    }

    proc getTclExecutableForTclShell { {shell ""} } {
      return [testExecTclScript {
        puts -nonewline stdout [info nameofexecutable]
      } $shell]
    }

    proc getTkVersionForTclShell { {shell ""} } {
      return [testExecTclScript {
        puts -nonewline stdout [package require Tk]; exit
      } $shell]
    }

    proc evalWithTclShell { script {raw false} {shell ""} {verbose false} } {
      return [testExecTclScript [string map \
          [list %script% $script %raw% $raw] {
        if {%raw%} then {
          set code [catch {%script%} result]
          puts -nonewline stdout [list $code $result]
        } else {
          puts -nonewline stdout [eval {%script%}]
        }
      }] $shell $verbose]
    }

    proc getGarudaDll { {machine ""} } {
      #
      # NOTE: Get the Garuda DLL of the same platform (i.e. machine type)
      #       as the native Tcl shell.
      #
      if {[info exists ::base_path]} then {
        #
        # NOTE: Get the effective test configuration.
        #
        set configuration [getTestConfiguration]

        #
        # NOTE: If there is no effective test configuration available, we
        #       cannot continue.
        #
        if {[string length $configuration] == 0} then {
          return ""
        }

        #
        # NOTE: Get the effective test suffix.  This is allowed to be an
        #       empty string.
        #
        set suffix [getTestSuffix]

        #
        # NOTE: If necessary, automatically detect the machine for the Tcl
        #       shell that we plan on using.
        #
        if {[string length $machine] == 0} then {
          set machine [getMachineForTclShell]
        }

        #
        # NOTE: Build the full path and file name of the Garuda DLL, using
        #       the Eagle base path.  Currently, this will only work
        #       correctly if the test suite is being run from inside the
        #       source tree.
        #
        return [file join $::base_path bin \
            [machineToPlatform $machine] [appendArgs $configuration Dll \
            $suffix] [appendArgs Garuda [info sharedlibextension]]]
      } else {
        #
        # NOTE: We are missing the base path, return nothing.
        #
        return ""
      }
    }

    proc cleanupExcel {} {
      #
      # TODO: These may need to be changed in later Excel versions.
      #
      object undeclare -declarepattern Microsoft.Office.Interop.Excel*
      object unimport -importpattern Microsoft.Office.Interop.Excel
    }

    proc cleanupVisualBasic {} {
      #
      # TODO: These may need to be changed in later framework versions.
      #
      object unimport -importpattern Microsoft.VisualBasic*
    }

    proc cleanupXml {} {
      #
      # TODO: These may need to be changed in later framework versions.
      #
      object unimport -importpattern System.Xml*
    }

    proc cleanupWinForms {} {
      #
      # TODO: These may need to be changed in later framework versions.
      #
      object unimport -importpattern System.Resources
      object unimport -importpattern System.Windows.Forms

      object unimport -importpattern \
          System.Windows.Forms.ComponentModel.Com2Interop

      object unimport -importpattern System.Windows.Forms.Design
      object unimport -importpattern System.Windows.Forms.Layout
      object unimport -importpattern System.Windows.Forms.PropertyGridInternal
      object unimport -importpattern System.Windows.Forms.VisualStyles
    }

    proc getTestLibraryDirectory {} {
      #
      # NOTE: First, query the location of the script library.  This will
      #       not work right in a "safe" interpreter.
      #
      if {[catch {info library} result] == 0} then {
        #
        # NOTE: Next, If the script library is embedded within the core
        #       library itself (i.e. the script library location refers
        #       to a file, not a directory), strip off the file name.
        #
        if {[file exists $result] && [file isfile $result]} then {
          set result [file dirname $result]
        }

        #
        # NOTE: Finally, return the resulting script library directory.
        #
        return $result
      }

      return ""
    }

    #
    # NOTE: Check for the test path in the various well-known locations
    #       and set the associated variable.
    #
    if {![info exists ::no(checkForAndSetTestPath)]} then {
      checkForAndSetTestPath false [expr {![isTestSuiteRunning]}]
    }

    #
    # NOTE: Fake loading and configuring the "tcltest" package unless we
    #       are prevented.
    #
    if {![info exists ::no(configureTcltest)]} then {
      configureTcltest "" [list] [list] [list] [list] false
    }

    ###########################################################################
    ############################# END Eagle ONLY ##############################
    ###########################################################################
  } else {
    ###########################################################################
    ############################# BEGIN Tcl ONLY ##############################
    ###########################################################################

    proc getPassPercentage {} {
      if {$::tcltest::numTests(Total) > 0} then {
        return [expr \
            {100.0 * (($::tcltest::numTests(Passed) + \
            $::tcltest::numTests(Skipped)) / \
            double($::tcltest::numTests(Total)))}]
      }

      return 0; # no tests were run, etc.
    }

    proc getSkipPercentage {} {
      if {$::tcltest::numTests(Total) > 0} then {
        return [expr \
            {100.0 * ($::tcltest::numTests(Skipped) / \
            double($::tcltest::numTests(Total)))}]
      }

      return 0; # no tests were run, etc.
    }

    #
    # NOTE: Check for the test path in the various well-known locations
    #       and set the associated variable.
    #
    if {![info exists ::no(checkForAndSetTestPath)]} then {
      checkForAndSetTestPath false [expr {![isTestSuiteRunning]}]
    }

    #
    # NOTE: Load and configure the "tcltest" package unless we are prevented.
    #
    if {![info exists ::no(configureTcltest)]} then {
      configureTcltest "" [list] [list] [list] [list test testConstraint] false
    }

    #
    # NOTE: We need several of our test related commands in the global
    #       namespace as well.
    #
    exportAndImportPackageCommands [namespace current] [list \
        tputs ttclLog doesTestLogHaveStartSentry tlog \
        getSoftwareRegistryKey haveConstraint addConstraint \
        haveOrAddConstraint getConstraints getCachedConstraints \
        useCachedConstraints removeConstraint fixConstraints \
        fixTimingConstraints calculateBogoCops calculateRelativePerformance \
        formatTimeStamp formatElapsedTime sourceIfValid \
        processTestArguments getTclShellFileName getTemporaryPath \
        getFiles getTestFiles getTestRunId getNewTestRunId getTestLogId \
        getDefaultTestLog getTestLog getLastTestLog getTestSuite \
        getTestMachine getTestPlatform getTestConfiguration getTestSuffix \
        getTestUncountedLeaks getRuntimeAssemblyName getTestAssemblyName \
        canTestExec testExec testClrExec execTestShell isRandomOrder \
        isBreakOnDemand isBreakOnLeak isStopOnFailure isStopOnLeak \
        isExitOnComplete returnInfoScript runTestPrologue runTestEpilogue \
        hookPuts unhookPuts runTest testDebugBreak testArrayGet testShim \
        tsource recordTestStatistics reportTestStatistics formatList \
        formatListAsDict pathToRegexp assemblyNameToRegexp \
        inverseLsearchGlob removePathFromFileNames formatDecimal \
        clearTestPercent reportTestPercent runAllTests isTestSuiteRunning \
        getTestChannelOrDefault tryVerifyTestPath checkForAndSetTestPath \
        configureTcltest machineToPlatform getPassPercentage \
        getSkipPercentage] false false

    ###########################################################################
    ############################## END Tcl ONLY ###############################
    ###########################################################################
  }

  #
  # NOTE: Provide the Eagle "test" package to the interpreter.
  #
  package provide Eagle.Test \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}