System.Data.SQLite

      #
      # NOTE: This should work properly in Tcl only.
      #
      # NOTE: Forget any previous commands that were imported from this
      #       namespace into the global namespace?
      #
      if {$forget} then {
        namespace forget ${namespace}::*
        namespace eval :: [list namespace forget [appendArgs $namespace ::*]]
      }

      #
      # NOTE: Process each of the commands to be exported from this
      # NOTE: Process each command to be exported from the specified
      #       namespace and import it into the global namespace, if
      #       necessary.
      #
      foreach export $exports {
        #
        # NOTE: Force importing of our exported commands into the
        #       global namespace?  Otherwise, see if the command is
        #       already present in the global namespace before trying
        #       to import it.
        # NOTE: Force importing of our exported commands into the global
        #       namespace?  Otherwise, see if the command is already
        #       present in the global namespace before trying to import
        #       it.
        #
        if {$force || [llength [info commands ::$export]] == 0} then {
          namespace export $export

        if {$force || \
            [llength [info commands [appendArgs :: $export]]] == 0} then {
          #
          # NOTE: Export the specified command from the specified namespace.
          #
          namespace eval $namespace [list namespace export $export]

          #
          # NOTE: Import the specified command into the global namespace.
          #
          set namespaceExport [appendArgs $namespace :: $export]

          if {$force} then {
            namespace eval :: [list namespace import -force \
            namespace eval :: [list namespace import -force $namespaceExport]
                ${namespace}::$export]
          } else {
            namespace eval :: [list namespace import \
            namespace eval :: [list namespace import $namespaceExport]
                ${namespace}::$export]
          }
        }
      }
    }

    #
    # NOTE: Exports the necessary commands from this package and import
    #       them into the global namespace.
    # NOTE: Exports the necessary commands from this package and import them
    #       into the global namespace.
    #
    exportAndImportPackageCommands [namespace current] [list \
        exportAndImportPackageCommands isEagle isMono getEnvironmentVariable \
        getPluginPath getDictionaryValue getColumnValue getRowColumnValue \
        appendArgs haveGaruda lappendArgs readFile filter map reduce \
        getPlatformInfo execShell] false false


  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] != 0} then {
        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.
          #
          error $error $::errorInfo $::errorCode

      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]]}
    }
  }

  proc reportTestStatistics { channel fileName varName } {
  proc reportTestStatistics { channel fileName statsVarName filesVarName } {
    set statistics [list afters variables commands procedures files \
        temporaryFiles channels aliases interpreters environment]

    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 scopes objects callbacks types interfaces \
          namespaces processes connections transactions modules \
          delegates tcl tclinterps tclthreads tclcommands; # assemblies
    }

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

    foreach statistic $statistics {
      if {$array($statistic,after) > $array($statistic,before)} then {
        incr count

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

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

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

    #
    # 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]
    }
  }

  proc formatList { list {default ""} {columns 1} } {
    set count 1
    set result ""

    foreach item $list {

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

    #
    # NOTE: So far, no files have had no files with failing tests.
    # 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 {

            #
            recordTestStatistics leaks after

            #
            # NOTE: Determine if any resource leaks have occurred and
            #       output diagnostics as necessary if they have.
            #
            reportTestStatistics $channel $fileName leaks
            reportTestStatistics $channel $fileName leaks leaked
          }
        } else {
          #
          # NOTE: This file does not actually count towards the total (i.e.
          #       it contains no actual tests).
          #
          incr total -1

    #
    clearTestPercent $channel

    tputs $channel [appendArgs "---- sourced " $count " test " \
        [expr {$count > 1 ? "files" : "file"}] \n]

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

    if {[llength $leaked] > 0} then {
      tputs $channel [appendArgs "---- files with leaking tests: " $leaked \n]
    }
  }

  proc configureTcltest { imports force } {
    if {[isEagle]} then {
      #
      # NOTE: Fake having the tcltest package.
      #

            {100.0 * ($::eagle_tests(skipped) / \
            double($::eagle_tests(total)))}]
      }

      return 0; # no tests were run, etc.
    }

    proc cleanupThread { thread } {
    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]
        }
              "---- 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]
          }
          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 "\" aborted\n"]

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

            return true; # joined?
          }
        } else {
          return true; # interrupted?
        }
      } else {
        return true; # already dead?
      }

      return false; # still alive (or error).
    }

    proc calculateBogoCops { {milliseconds 2000} } {
      #
      # 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: 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 the potential for a "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 to calculate the number of commands-per-second
          #       due to some subtle race condition [as 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 =$flags
        }
      } finally {
        interp bgerror {} $bgerror
      }
    }

    proc evalWithTimeout { script {milliseconds 2000} {resultVarName ""} } {
      #
      # 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 event [after $milliseconds [list interp cancel]]

          set before [info cmdcount]
          #
          # NOTE: Evaluate the specified script in the context of the caller,
          #       returning the result to the caller.
          catch {time {nop} -1}; # internal busy loop.
          set after [info cmdcount]

          #
          #
          if {[string length $resultVarName] > 0} then {
            upvar 1 $resultVarName result
          }

          # HACK: Mono has a bug that results in excessive trailing zeros
          #       here (Mono bug #655780).
          #
          if {[isMono]} then {
            return [expr \
                {double(($after - $before) / ($milliseconds / 1000.0))}]
          return [catch {
            #
            # NOTE: Schedule the event to cancel the script we are about to
            #       evaluate, capturing the name so we can cancel it later, if
            #       necessary.
          } else {
            return [expr {($after - $before) / ($milliseconds / 1000.0)}]
          }
            #
            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 =$flags
        }

      if {![info exists ::no(compileNetwork)]} then {
        addConstraint compile.NETWORK
      }

      tputs $channel no\n
    }
  }

  proc checkForSymbols { channel name {constraint ""} } {
    set fileName [file normalize [appendArgs [file rootname $name] .pdb]]

    tputs $channel [appendArgs "---- checking for symbols \"" $fileName \
        "\"... "]

    if {[file exists $fileName]} then {
      #
      # NOTE: The file appears to have associated symbols available.
      #
      if {[string length $constraint] > 0} then {
        addConstraint [appendArgs symbols_ $constraint]
      } else {
        addConstraint [appendArgs symbols_ [file tail $name]]
      }

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }

  proc checkForLogFile { channel } {
    tputs $channel "---- checking for log file... "

    if {[info exists ::test_log] && \
        [string length $::test_log] > 0 && \
        [file exists $::test_log]} then {

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }

  proc checkForTiming { channel threshold } {
  proc checkForTiming { channel threshold {tries 2} } {
    tputs $channel "---- checking for precision timing... "

    #
    # NOTE: Are we allowed to do precision timing tests?
    # HACK: Sometimes the first try takes quite a bit longer than subsequent
    #       tries.  We attempt to bypass this problem by retrying a set number
    #       of times (which can be overridden by the caller) before giving up.
    #
    if {![info exists ::no(timing)]} then {
    for {set try 0} {$try < $tries} {incr try} {
      #
      # NOTE: Attempt to block for exactly one second.
      #
      set start [expr {[clock clicks -milliseconds] & 0x7fffffff}]
      after 1000; # wait for "exactly" one second.
      set stop [expr {[clock clicks -milliseconds] & 0x7fffffff}]

      #
      # NOTE: Calculate the difference between the actual and expected
      #       number of milliseconds.
      #
      set difference [expr {abs($stop - $start - 1000)}]

      #
      # NOTE: Are we within the threshold specified by the caller?
      #
      if {$difference >= 0 && $difference <= $threshold} then {
        #
        # NOTE: We appear to be capable of fairly precise timing.
        #
        addConstraint timing

        tputs $channel [appendArgs "yes (0 <= " $difference " <= " \
            $threshold " milliseconds)\n"]
      } else {
        tputs $channel [appendArgs "no (0 <= " $difference " > " \
            $threshold " milliseconds)\n"]
            $threshold " milliseconds, tried " [expr {$try + 1}] \
            " " [expr {$try > 0 ? "times" : "time"}] ")\n"]

        #
        # NOTE: We are done here, return now.
        #
        return
      }
    } else {
      tputs $channel no\n
    }

    tputs $channel [appendArgs "no (0 <= " $difference " > " \
        $threshold " milliseconds)\n"]
  }

  proc checkForPerformance { channel } {
    tputs $channel "---- checking for performance testing... "

    #
    # NOTE: Are we allowed to do performance testing?

    # NOTE: We need several of our test constraint related commands in the
    #       global namespace.
    #
    exportAndImportPackageCommands [namespace current] [list checkForPlatform \
        checkForEagle checkForGaruda checkForShell checkForDebug checkForTk \
        checkForVersion checkForCommand checkForFile checkForNativeCode \
        checkForTip127 checkForTip194 checkForTip241 checkForTip285 \
        checkForPerformance checkForTiming checkForInteractive checkForLogFile \
        checkForNetwork checkForCompileOption checkForUserInteraction] false \
        false
        checkForPerformance checkForTiming checkForInteractive checkForSymbols \
        checkForLogFile checkForNetwork checkForCompileOption \
        checkForUserInteraction] false false

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

    #       sub-directory inside of the "Library" project directory
    #       simply due to the links contained in the project file that
    #       actually point to the "lib\Eagle1.0" sub-directory under the
    #       solution directory.
    #
    # WARNING: The Eagle package name and version are hard-coded here.
    #
    set pkg_dir Eagle1.0; # TODO: Change me.

    if {![file exists [file join $base_path lib]] || \
        ![file isdirectory [file join $base_path lib]] || \
        ![file exists [file join $base_path lib Eagle1.0]] || \
        ![file isdirectory [file join $base_path lib Eagle1.0]] || \
        ![file exists [file join $base_path lib Eagle1.0 init.eagle]] || \
        ![file isfile [file join $base_path lib Eagle1.0 init.eagle]]} then {
        ![file exists [file join $base_path lib $pkg_dir]] || \
        ![file isdirectory [file join $base_path lib $pkg_dir]] || \
        ![file exists [file join $base_path lib $pkg_dir init.eagle]] || \
        ![file isfile [file join $base_path lib $pkg_dir init.eagle]]} then {
      #
      # NOTE: We do not bother to check if the "lib" sub-directory
      #       actually exists as a child of this one.  This is the
      #       previous (legacy) behavior (i.e. where we always went
      #       up two levels to the base directory).
      # NOTE: We do not bother to check if the "lib" sub-directory actually
      #       exists as a child of this one.  This is the previous (legacy)
      #       behavior (i.e. where we always went up two levels to the base
      #       directory).
      #
      set base_path [file dirname $base_path]
    }

    unset pkg_dir
  }

  #
  # NOTE: Set the local root directory of the source checkout (i.e. of
  #       Eagle or whatever project the Eagle binaries are being used by).
  #
  if {![info exists root_path]} then {

      # NOTE: We extracted the local root directory of the source checkout
      #       from Fossil.  Now, make sure it is fully normalized and has no
      #       trailing slashes.
      #
      set root_path [file normalize $directory]
    }

    unset -nocomplain directory exec pattern
    unset -nocomplain directory dummy exec pattern
  }

  #
  # NOTE: Set the executable file name for the process, if
  #       necessary.
  #
  if {![info exists bin_file]} then {

      #
      # NOTE: Can we access the local database?
      #
      checkForDatabase $test_channel $test_database
      unset password user timeout database server
    }

    #
    # NOTE: Has symbol testing support been disabled?
    #
    if {![info exists no(assemblySymbols)]} then {
      checkForSymbols $test_channel [lindex [info assembly] end]
    }

    #
    # NOTE: Has quiet testing support been disabled?
    #
    if {![info exists no(quiet)]} then {
      #
      # NOTE: For tests "basic-1.36", "debug-1.3", "debug-1.4", "object-10.*",
      #       and "perf-2.2".

      #
      if {![info exists no(compileXml)]} then {
        #
        # NOTE: For tests "commands-1.4", "object-7.3" and "xml-1.1.*".
        #
        checkForCompileOption $test_channel XML
      }

      #
      # NOTE: Has serialization support been enabled (at compile-time)?
      #
      if {![info exists no(compileSerialization)]} then {
        #
        # NOTE: For test "interp-1.10".
        #
        checkForCompileOption $test_channel SERIALIZATION
      }

      #
      # NOTE: Has dedicated test support been enabled (at compile-time)?
      #
      if {![info exists no(compileTest)]} then {
        #
        # NOTE: For tests "basic-1.20", "basic-1.21", "function-1.1",

  if {![info exists no(eagle)]} then {
    checkForEagle $test_channel
  }

  if {![info exists no(noLogFile)]} then {
    checkForLogFile $test_channel
  }

  if {![info exists no(symbols)]} then {
    checkForSymbols $test_channel [info nameofexecutable]
  }

  if {![info exists no(garuda)]} then {
    checkForGaruda $test_channel
  }

  if {![info exists no(shell)]} then {
    checkForShell $test_channel

      if {[isMono]} then {
        #
        # HACK: We need something to go into the log file.
        #
        set timeStamp [lindex $timeStamp 0]
      } else {
        set timeStamp [clock format [clock scan $timeStamp] -iso]
        set timeStamp [clock format [clock scan $timeStamp] -iso -isotimezone]
      }
    } else {
      set timeStamp <none>
    }

    tputs $test_channel [appendArgs "---- build: " \
        [list [getPlatformInfo engine <none>]] " " \