System.Data.SQLite

namespace eval ::Eagle {
  #
  # NOTE: This is the procedure that detects whether or not we are
  #       running in Eagle (otherwise, we are running in vanilla Tcl).
  #       This procedure must function correctly in both Tcl and Eagle
  #       and must return non-zero only when running in Eagle.  This
  #       procedure must be defined in this script file because it is
  #       needed while this script file is being evaluated.  The same
  #       procedure is also defined in the "platform.eagle" file.
  #
  # <bootstrap>
  proc isEagle {} {
    #
    # NOTE: Nothing too fancy or expensive should be done in here.  In
    #       theory, use of this routine should be rare; however, in
    #       practice, this routine is actually used quite a bit (e.g.


  #
  # NOTE: This procedure returns a string obtained by using the specified
  #       value as an opaque object handle -OR- a default value (e.g. an
  #       empty string) if the value is not a valid opaque object handle.
  #
  proc getStringFromObjectHandle { value {default ""} } {


    if {[isNonNullObjectHandle $value]} then {
      return [object invoke $value ToString]
    }

    if {[string length $default] > 0} then {
      return $default
    }

    if {[llength $objects] == 1 && [lindex $objects 0] eq $value} then {
      return true
    }

    return false
  }

  #
  # NOTE: This procedure returns non-zero if the specified value can be used
  #       as an opaque object handle -AND- the value does not represent a null
  #       value.
  #
  proc isNonNullObjectHandle { value } {
    global null
    return [expr {[isObjectHandle $value] && $value ne $null}]
  }

  #
  # NOTE: This procedure returns non-zero if the specified name represents
  #       a valid CLR type name.
  #
  proc isManagedType { name } {
    if {[llength [info commands object]] > 0} then {

          }
        }
      }
    }

    return false
  }

  #
  # NOTE: This procedure evaluates a script asynchronously and optionally
  #       notifies another script upon its completion.  The first argument
  #       is the notification script; if an empty string, there will be no
  #       notification when asynchronous script evaluation is completed.
  #       If there is exactly one more argument, it is evaluated verbatim;
  #       otherwise, all remaining arguments are concatenated via [concat]
  #       and evaluated asynchronously.  If the script cannot be submitted
  #       for asynchronous evaluation, a script error will be raised.
  #
  proc evalAsync { doneScript args } {
    #
    # NOTE: This procedure requires the [object] command in order to work.
    #       If it is not available, bail out now.
    #
    if {[llength [info commands object]] == 0} then {
      error "cannot eval async: missing \[object\] command"
    }

    #
    # NOTE: If the core library was not compiled with thread-safety enabled,
    #       this procedure cannot be used because it could corrupt the state
    #       of the interpreter.
    #
    if {[lsearch -exact -- \
        $::eagle_platform(compileOptions) THREADING] == -1} then {
      error "cannot eval async: library missing THREADING compile-option"
    }

    #
    # NOTE: If there is more than one script optional argument, use [concat]
    #       to build up the final script; otherwise, use the single argument
    #       verbatim.  This mirrors the behavior of [eval].
    #
    if {[llength $args] > 1} then {
      set asyncScript [concat $args]
    } else {
      set asyncScript [lindex $args 0]
    }

    #
    # NOTE: Is there a script to be evaluated when the asynchronous script
    #       evaluation is complete?  If so, build an anonymous procedure
    #       that wraps it; otherwise, set the callback argument to null, so
    #       the core marshaller will handle the lack of a callback correctly.
    #       The context argument will be added to this script prior to it
    #       being evaluated; however, it is not actually used by this script.
    #
    if {[string length $doneScript] > 0} then {
      set callback [list -callbackflags {+ResetCancel FireAndForget} \
          -- apply [list [list script context] {uplevel 1 $script}] \
          $doneScript]
    } else {
      set callback null
    }

    #
    # NOTE: Initialize the local variable that will be used to receive the
    #       script error, if any.
    #
    set error null

    #
    # NOTE: Attempt to submit the script for asynchonous evaluation.  Use
    #       the dynamic callback mechanism with the anonymous procedure we
    #       constructed above.
    #
    set code [object invoke -verbose \
        -marshalflags +DynamicCallback -- Interpreter.GetActive \
        EvaluateScript $asyncScript $callback null error]

    #
    # NOTE: Check the return code, which only indicates if the script was
    #       actually submitted for asynchronous evaluation, to make sure
    #       it was successful.  If not, raise a script error.
    #
    if {$code ne "Ok"} then {
      error [getStringFromObjectHandle $error]
    }

    #
    # NOTE: Upon success, return an empty string.  The actual script result
    #       will be sent to the callback script, if any.
    #
    return ""
  }

  #
  # NOTE: Provide the Eagle "object" package to the interpreter.
  #
  package provide Eagle.Object \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}


    # NOTE: The URI where the Package Client Toolset may be downloaded.
    #
    variable packageToolsetUri; # DEFAULT: ${baseUri}/${packageToolsetUrn}

    if {$force || ![info exists packageToolsetUri]} then {
      set packageToolsetUri {${baseUri}/${packageToolsetUrn}}
    }

    #
    # NOTE: The URN, relative to the base URI, where the TclKit DLL for
    #       a particular platform may be downloaded.
    #
    variable tclKitDllUrn; # DEFAULT: tclkit_dll_${platform}

    if {$force || ![info exists tclKitDllUrn]} then {
      set tclKitDllUrn {tclkit_dll_${platform}}
    }

    #
    # NOTE: The URI where the TclKit DLL for a particular platform may
    #       be downloaded.
    #
    variable tclKitDllUri; # DEFAULT: ${baseUri}/${urn}

    if {$force || ![info exists tclKitDllUri]} then {
      set tclKitDllUri {${baseUri}/${urn}}
    }

    #
    # NOTE: The URN, relative to the base URI, where the Harpy and Badge
    #       plugins for a particular build may be downloaded.
    #
    variable securityToolsetUrn; # DEFAULT: security_toolset_${platform}

    if {$force || ![info exists securityToolsetUrn]} then {
      set securityToolsetUrn {security_toolset_${platform}}
    }

    #
    # NOTE: The URI where the Harpy and Badge plugins for a particular
    #       build may be downloaded.
    #
    variable securityToolsetUri; # DEFAULT: ${baseUri}/${urn}

    if {$force || ![info exists securityToolsetUri]} then {
      set securityToolsetUri {${baseUri}/${urn}}
    }

    #
    # NOTE: The URN, relative to the base URI, where license certificate
    #       requests should be sent.
    #
    variable licenseUrn; # DEFAULT: get_license_01

    if {$force || ![info exists licenseUrn]} then {
      set licenseUrn get_license_01
    }

    #
    # NOTE: The URI where license certificate requests should be sent.
    #
    variable licenseUri; # DEFAULT: ${baseUri}/${urn}

    if {$force || ![info exists licenseUri]} then {
      set licenseUri {${baseUri}/${urn}}
    }
  }

  #
  # NOTE: This procedure attempts to download and extract the Package Client
  #       Toolset.  The optional channel argument is the output channel where
  #       diagnostic information is sent.  The optional quiet argument should
  #       be non-zero to prevent diagnostic information from being emitted.

      writeFile $fileName $data
    }

    set extractDirectory [extractZipArchive $fileName $extractRootDirectory]
    return [file join $extractDirectory pkgr_an_d client 1.0 neutral]
  }

  #
  # NOTE: This procedure attempts to download and extract a native TclKit DLL
  #       for the current platform.  The optional channel argument is the
  #       output channel where diagnostic information is sent.  The optional
  #       quiet argument should be non-zero to prevent diagnostic information
  #       from being emitted.  This procedure may raise script errors.  The
  #       return value is the full path to the native TclKit DLL file.
  #
  proc downloadAndExtractNativeTclKitDll {
          {channel stdout} {quiet false} } {
    setupPackageToolsetVars false

    variable baseUri
    variable tclKitDllUri
    variable tclKitDllUrn

    package require Eagle.Test
    package require Eagle.Unzip

    set extractRootDirectory [getTemporaryPath]

    set directory [file join $extractRootDirectory [appendArgs \
        ea-td-di- [pid] - [string trim [clock seconds] -]]]

    set platform [machineToPlatform $::tcl_platform(machine) true]
    set urn [subst $tclKitDllUrn]; set uri [subst $tclKitDllUri]
    set fileName [getTemporaryFileName]

    if {[isEagle]} then {
      uri download $uri $fileName
    } else {
      package require Eagle.Tools.Common

      namespace import \
          ::Eagle::Tools::Common::getFileViaHttp \
          ::Eagle::Tools::Common::writeFile

      set data [getFileViaHttp $uri 20 $channel $quiet -binary true]

      writeFile $fileName $data
    }

    set extractDirectory [extractZipArchive $fileName $extractRootDirectory]

    return [lindex [glob -nocomplain \
        [file join $extractDirectory lib *[info sharedlibextension]]] 0]
  }

  #
  # NOTE: This procedure attempts to download and extract the Security Toolset,
  #       which includes the Harpy and Badge plugins.  The optional channel
  #       argument is the output channel where diagnostic information is sent.
  #       The optional quiet argument should be non-zero to prevent diagnostic
  #       information from being emitted.  This procedure may raise script
  #       errors.  The return value is the full path to a directory that should
  #       contain the "Harpy1.0" and "Badge1.0" plugin directories.
  #
  proc downloadAndExtractSecurityToolset {
          {channel stdout} {quiet false} } {
    setupPackageToolsetVars false

    variable baseUri
    variable securityToolsetUri
    variable securityToolsetUrn

    package require Eagle.Test
    package require Eagle.Unzip

    set extractRootDirectory [getTemporaryPath]

    set directory [file join $extractRootDirectory [appendArgs \
        ea-st-di- [pid] - [string trim [clock seconds] -]]]

    if {[info exists ::eagle_platform(text)]} then {
      set platform [string tolower $::eagle_platform(text)]
    } else {
      set platform [string tolower netFx20]; # TODO: Good default?
    }

    set dir [string map [list fx ""] $platform]; # netfx20 -> net20
    set urn [subst $securityToolsetUrn]; set uri [subst $securityToolsetUri]
    set fileName [getTemporaryFileName]

    if {[isEagle]} then {
      uri download $uri $fileName
    } else {
      package require Eagle.Tools.Common

      namespace import \
          ::Eagle::Tools::Common::getFileViaHttp \
          ::Eagle::Tools::Common::writeFile

      set data [getFileViaHttp $uri 20 $channel $quiet -binary true]

      writeFile $fileName $data
    }

    set extractDirectory [extractZipArchive $fileName $extractRootDirectory]
    return [file join $extractDirectory build $dir lib]
  }

  #
  # NOTE: This procedure attempts to request a license certificate for Eagle,
  #       which includes the Harpy and Badge plugins.  The optional channel
  #       argument is the output channel where diagnostic information is sent.
  #       The optional quiet argument should be non-zero to prevent diagnostic
  #       information from being emitted.  This procedure may raise script
  #       errors.  The return value is the fully qualified file name for the
  #       resulting license certificate.
  #
  # WARNING: This procedure will send the short name and display name of the
  #          currently logged on user to the Eagle license server as they are
  #          required for a new license certificate to be issued.  Abuse of
  #          this service may result in a permanent ban from the service and
  #          revocation of any previously issued license certificates.
  #
  proc requestLicenseCertificate {
          {channel stdout} {quiet false} } {
    setupPackageToolsetVars false

    variable baseUri
    variable licenseUri
    variable licenseUrn

    package require Eagle.Test

    set certificateRootDirectory [getTemporaryPath]

    set processDirectoryPrefix [file join $certificateRootDirectory \
        [appendArgs ea-lc-di- [pid] -]]

    #
    # NOTE: Issue a warning to the user if it appears there is already a
    #       license certificate in a temporary directory that was created
    #       by this process.  Hopefully, this should reduce the number of
    #       duplicate requests.
    #
    set varName1 YES_PLEASE_FORCE_A_LICENSE_CERTIFICATE_REQUEST

    if {![info exists ::env($varName1)] && [isWindows]} then {
      set processFileNames [list]

      foreach processDirectory [findDirectories \
          [appendArgs $processDirectoryPrefix *]] {
        eval lappend processFileNames [findFiles \
            [file join $processDirectory *]]
      }

      if {[llength $processFileNames] > 0} then {
        set warningCommand [list]

        if {[isEagle]} then {
          lappend warningCommand host result Error
        } else {
          lappend warningCommand puts stderr
        }

        set varName2 Master_Certificate

        lappend warningCommand [appendArgs \
            "One or more temporary license certificate files " \
            "apparently belonging to this process were found.  " \
            "If you wish to override this warning and force a " \
            "new license certificate request to be submitted, " \
            "set the \"" $varName1 "\" environment variable " \
            "(to anything); however, please keep in mind that " \
            "requesting too many license certificates and/or " \
            "requesting license certificates too fast MAY be " \
            "considered abusive behavior.  Upon success, the " \
            "resulting temporary license certificate file " \
            "SHOULD be saved to a secure location on the local " \
            "file system, e.g. the home directory associated " \
            "with the user submitting the license certificate " \
            "request.  The fully qualified file name for the " \
            "temporary license certificate MUST used as the " \
            "value for the \"" $varName2 "\" environment " \
            "variable; otherwise, it MAY NOT be found when one " \
            "of its associated plugins attempts to load.\n"]

        #
        # NOTE: Emit our carefully worded license warning message.
        #
        eval $warningCommand

        #
        # NOTE: Return the first pre-existing license certificate file
        #       name that was found.
        #
        return [lindex $processFileNames 0]
      }
    }

    set directory [appendArgs \
        $processDirectoryPrefix [string trim [clock seconds] -]]

    set urn [subst $licenseUrn]; set uri [subst $licenseUri]

    if {![isEagle] || [catch {
      object invoke System.Security.Principal.WindowsIdentity \
          GetCurrent.Name
    } userName]} then {
      #
      # HACK: Fallback to using a value from the "tcl_platform" array.
      #       For native Tcl, this is the only choice.  For Eagle, it
      #       is used as a fallback.
      #
      if {[info exists ::tcl_platform(user)]} then {
        set userName $::tcl_platform(user)
      } else {
        set userName "NO USER NAME"
      }
    }

    if {![isEagle] || [catch {
      object load System.DirectoryServices.AccountManagement

      object invoke \
          System.DirectoryServices.AccountManagement.UserPrincipal \
          Current.DisplayName
    } displayName]} then {
      #
      # HACK: Fallback to using a value from the "tcl_platform" array.
      #       This value is not set by native Tcl or Eagle; therefore,
      #       the user would have to set it manually prior to calling
      #       this procedure.
      #
      if {[info exists ::tcl_platform(userDisplayName)]} then {
        set displayName $::tcl_platform(userDisplayName)
      } else {
        set displayName "NO DISPLAY NAME"
      }
    }

    #
    # NOTE: Add the necessary query parameters to the license request
    #       URI, making sure to properly escape their values.
    #
    if {[isEagle]} then {
      append uri ?userName= [uri escape data $userName]
      append uri &displayName= [uri escape data $displayName]
    } else {
      package require http 2.0

      append uri ? [::http::formatQuery \
          userName $userName displayName $displayName]
    }

    if {[isEagle]} then {
      set data [uri download -inline $uri]
    } else {
      package require Eagle.Tools.Common

      namespace import \
          ::Eagle::Tools::Common::getFileViaHttp \
          ::Eagle::Tools::Common::writeFile

      set data [getFileViaHttp $uri 20 $channel $quiet -binary true]
      package require Eagle.Auxiliary
    }

    if {[getDictionaryValue $data returnCode] ne "Ok"} then {
      if {[string length $data] > 0} then {
        error [appendArgs \
            "request failed with error information: " $data]
      } else {
        error "request failed without providing error information"
      }
    }

    set fileName [getTemporaryFileName]
    writeFile $fileName [getDictionaryValue $data result]
    set newFileName [file join $directory [file tail $fileName]]

    file mkdir $directory; file copy $fileName $newFileName
    file delete $fileName

    return $newFileName
  }

  #
  # NOTE: Provide the Eagle "package toolset" package to the interpreter.
  #
  package provide Eagle.Package.Toolset \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}


#       namespace if this script actually ends up being evaluated in Tcl.
#
namespace eval ::Eagle {
  #
  # NOTE: This is the procedure that detects whether or not we are running
  #       in Eagle (otherwise, it is assumed that we are running in vanilla
  #       Tcl).  This procedure must work correctly in both Tcl and Eagle
  #       and must return non-zero only when running in Eagle.  The same
  #       procedure is also defined in the "init.eagle" file.
  #
  proc isEagle {} {
    #
    # NOTE: Nothing too fancy or expensive should be done here.  In theory,
    #       use of this procedure should be rare; however, in practice, this
    #       procedure is actually used quite a bit (e.g. by the test suite).
    #

namespace eval ::Eagle {
  #
  # NOTE: This is the procedure that detects whether or not we are
  #       running in Eagle (otherwise, we are running in vanilla Tcl).
  #       This procedure must function correctly in both Tcl and Eagle
  #       and must return non-zero only when running in Eagle.  This
  #       procedure must be defined in this script file because it is
  #       needed while this script file is being evaluated.  The same
  #       procedure is also defined in the "init.eagle" file.
  #
  # <bootstrap>
  proc isEagle {} {
    #
    # NOTE: Nothing too fancy or expensive should be done in here.  In
    #       theory, use of this routine should be rare; however, in
    #       practice, this routine is actually used quite a bit (e.g.

    #
    # 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 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 {

              return 0
            }
          } finally {
            if {[info exists event]} then {
              catch {after cancel $event}
            }

            after flags [appendArgs = $flags]
          }
        } finally {
          interp bgerror {} $bgerror
        }
      } finally {
        interp readylimit {} $readylimit
      }

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

      #
      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 ".*?":\

      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 failed [list]
    set leaked [list]

    #
    # NOTE: Process each file name we have been given by the caller...
    #
    set total 0; 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)) : 100}]]

      if {$percent != $lastPercent} then {

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

            #
            # NOTE: At this point, we know that another test file was
            #       processed successfully.
            #
            incr total

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

            #
            # 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 {

              #       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: We evaluated another test file.
          #
          incr count

          # 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: In terms of files, not tests, what percent done are we now?
        #
        set percent [formatDecimal \
            [expr {$total != 0 ? 100.0 * ($count / double($total)) : 100}]]

        #
        # 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: In terms of files, not tests, what percent done are we now?
      #
      set percent [formatDecimal \
          [expr {$total != 0 ? 100.0 * ($count / double($total)) : 100}]]

      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]

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

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

        fixConstraints fixTimingConstraints calculateBogoCops \
        calculateRelativePerformance formatTimeStamp formatElapsedTime \
        sourceIfValid processTestArguments getTclShellFileName \
        getTemporaryPath getFiles getTestFiles getTestRunId getTestLogId \
        getDefaultTestLog getTestLog getLastTestLog getTestSuite \
        getTestMachine getTestPlatform getTestConfiguration getTestSuffix \
        getTestUncountedLeaks 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 \
        inverseLsearchGlob removePathFromFileNames formatDecimal \
        clearTestPercent reportTestPercent runAllTests isTestSuiteRunning \
        getTestChannelOrDefault tryVerifyTestPath checkForAndSetTestPath \

#       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 getKnownBuildTypes {} {
    return [list \
        NetFx20 NetFx35 NetFx40 NetFx45 NetFx451 NetFx452 \
        NetFx46 NetFx461 NetFx462 NetFx47 NetFx471 Bare \
        LeanAndMean Database MonoOnUnix Development]
  }

  proc getKnownCompileOptions {} {
    return [list \
        APPDOMAINS APPROVED_VERBS ARGUMENT_CACHE ARM ARM64 ASSEMBLY_DATETIME \
        ASSEMBLY_RELEASE ASSEMBLY_STRONG_NAME_TAG ASSEMBLY_TAG ASSEMBLY_TEXT \
        ASSEMBLY_URI BREAK_ON_EXITING BREAKPOINTS CACHE_ARGUMENT_TOSTRING \
        CACHE_ARGUMENTLIST_TOSTRING CACHE_DICTIONARY CACHE_RESULT_TOSTRING \
        CACHE_STATISTICS CACHE_STRINGLIST_TOSTRING CALLBACK_QUEUE CAS_POLICY \
        CERTIFICATE_PLUGIN CERTIFICATE_POLICY CERTIFICATE_RENEWAL \
        CODE_ANALYSIS COM_TYPE_CACHE CONSOLE DAEMON DATA DEAD_CODE DEBUG \
        DEBUGGER DEBUGGER_ARGUMENTS DEBUGGER_ENGINE DEBUGGER_EXECUTE \
        DEBUGGER_EXPRESSION DEBUGGER_VARIABLE DEBUG_TRACE DEBUG_WRITE \
        DEMO_EDITION DRAWING DYNAMIC EAGLE EMBEDDED_LIBRARY \
        EMBED_CERTIFICATES ENTERPRISE_LOCKDOWN EXECUTE_CACHE EXPRESSION_FLAGS \
        FAST_ERRORCODE FAST_ERRORINFO FOR_TEST_USE_ONLY HAVE_SIZEOF HISTORY \
        IA64 INTERACTIVE_COMMANDS INTERNALS_VISIBLE_TO ISOLATED_INTERPRETERS \
        ISOLATED_PLUGINS LIBRARY LICENSING LICENSE_MANAGER LIMITED_EDITION \
        LIST_CACHE MONO MONO_BUILD MONO_HACKS MONO_LEGACY NATIVE \
        NATIVE_PACKAGE NATIVE_THREAD_ID NATIVE_UTILITY NATIVE_UTILITY_BSTR \
        NETWORK NET_20 NET_20_FAST_ENUM NET_20_ONLY NET_20_SP1 NET_20_SP2 \
        NET_30 NET_35 NET_40 NET_45 NET_451 NET_452 NET_46 NET_461 NET_462 \
        NET_47 NET_471 NON_WORKING_CODE NOTIFY NOTIFY_ACTIVE NOTIFY_ARGUMENTS \
        NOTIFY_EXCEPTION NOTIFY_EXECUTE NOTIFY_EXPRESSION NOTIFY_GLOBAL \
        NOTIFY_OBJECT OBSOLETE OBFUSCATION OFFICIAL PARSE_CACHE PATCHLEVEL \
        PLUGIN_COMMANDS POLICY_TRACE PREVIOUS_RESULT RANDOMIZE_ID REMOTING \
        RESULT_LIMITS SAMPLE SECURITY SERIALIZATION SHARED_ID_POOL SHELL \
        SOURCE_ID SOURCE_TIMESTAMP STATIC TCL TCL_KITS TCL_THREADED \
        TCL_THREADS TCL_UNICODE TCL_WRAPPER TEST TEST_PLUGIN THREADING \
        THROW_ON_DISPOSED TRACE TYPE_CACHE UNIX USE_APPDOMAIN_FOR_ID \
        USE_NAMESPACES VERBOSE WEB WINDOWS WINFORMS WIX_30 WIX_35 WIX_36 \
        WIX_37 WIX_38 WIX_39 WIX_310 WIX_311 X64 X86 XML]
  }

  proc getKnownMonoVersions { {force false} } {
    #
    # NOTE: This job of this procedure is to return the list of "known"
    #       versions of Mono supported by the test suite infrastructure.
    #

      #
      return true
    }

    set reason "skipped, need Eagle"
    return false
  }

  proc cleanConstraintName { name } {
    #
    # NOTE: Start with the original constraint name, removing surrounding
    #       whitespace.  If this results in an empty string, we are done.
    #
    set result [string trim $name]

    if {[string length $result] == 0} then {
      return $result
    }

    #
    # NOTE: The constraints for a test are actually a list; therefore, we
    #       must remove anything that might confuse the list parser.
    #
    set result [string map [list \" "" \\ "" \{ "" \} ""] $result]

    #
    # NOTE: In order to avoid semantic confusion, remove other characters
    #       that may be reserved by the test suite subsystems.
    #
    set result [string map [list ! "" # "" \$ "" \; "" \[ "" \] ""] $result]

    #
    # NOTE: Finally, remove all remaining whitespace.
    #
    regsub -all -- {\s} $result "" result; return $result
  }

  proc cleanPackageName { package full } {
    #
    # NOTE: Start out with the original package name, removing surrounding
    #       whitespace.  If this results in an empty string, we are done.
    #
    set result [string trim $package]

    #       names.  For now, they are all replaced with underscores by this
    #       procedure.  Any existing underscores in the string are doubled.
    #
    set charMap [list _ __ " " _ + _ , _ . _ = _ \[ _ \\ _ \] _ ` _]

    return [string map $charMap $result]
  }

  proc haveTclPlatformOsExtraUpdateName { name } {
    if {[info exists ::tcl_platform(osExtra)]} then {
      set updateNames [getDictionaryValue $::tcl_platform(osExtra) \
          UpdateNames]

      if {[lsearch -exact $updateNames $name] != -1} then {
        return true
      }
    }

    return false
  }

  proc checkForTestSuiteFiles { channel } {
    tputs $channel "---- checking for test suite files... "

    #
    # NOTE: Start out with no test suite files to check.
    #

        #
        return
      }
    }

    tputs $channel no\n
  }

  proc checkForOperatingSystemUpdate { channel name } {
    tputs $channel [appendArgs \
        "---- checking for operating system update \"" \
        $name "\"... "]

    #
    # NOTE: Is the specific OS update currently installed?
    #
    if {[haveTclPlatformOsExtraUpdateName $name]} then {
      addConstraint [appendArgs osUpdate . [cleanConstraintName $name]]

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }

  proc checkForScriptLibrary { channel } {
    tputs $channel "---- checking for script library... "

    #
    # NOTE: See if the variable containing the script library location
    #       exists.

    #
    # NOTE: Does the interpreter have TIP #405 (i.e. [lmap])?
    #
    catch {lmap} error

    if {$error ne "invalid command name \"lmap\""} then {
      addConstraint tip405

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }

  proc checkForTip421 { channel } {
    tputs $channel "---- checking for TIP #421... "

    #
    # NOTE: Is the interpreter TIP #421 ready?
    #
    if {[catch {
      set array(1) one; set list [list]

      array for {name value} array {
        lappend list $name $value
      }

      set list
    } result] == 0 && $result eq [list 1 one]} then {
      addConstraint tip421

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }


          #
          set key [appendArgs HKEY_LOCAL_MACHINE\\ \
              [getSoftwareRegistryKey true] {\Microsoft\Windows Installer XML}]

          #
          # NOTE: The versions of WiX that we support.
          #
          set versions [list 3.11 3.10 3.9 3.8 3.7 3.6 3.5 3.0]

          #
          # NOTE: Check each version, stopping when one is found.
          #
          foreach version $versions {
            #
            # NOTE: Attempt to fetch the WiX install directory value from the

          #
          return
        }
      }

      tputs $channel no\n
    }

    proc getFrameworkSetup451Value {} {
      #
      # NOTE: Check if we are running on Windows 8.1.
      #
      # BUGBUG: Is exact matching correct here?
      #
      if {[isWindows] && [info exists ::tcl_platform(osVersion)] && \
          $::tcl_platform(osVersion) == 6.3} then {
        #
        # NOTE: We are running on Windows 8.1, return the special value.
        #
        return 378675
      }

      #
      # NOTE: We are not running on Windows 8.1, return the normal value.
      #
      return 378758
    }

    proc getFrameworkSetup46Value {} {
      #
      # NOTE: Check if we are running on Windows 10 or later.
      #
      # BUGBUG: Is greater-than-or-equal-to matching correct here?
      #
      if {[isWindows] && [info exists ::tcl_platform(osVersion)] && \
          $::tcl_platform(osVersion) >= 10.0} then {
        #
        # NOTE: We are running on Windows 10, return the special value.
        #
        return 393295
      }

      #
      # NOTE: We are not running on Windows 10, return the normal value.
      #
      return 393297
    }

    proc getFrameworkSetup461Value {} {
      #
      # NOTE: Check if we are running on Windows 10 or later.
      #
      # BUGBUG: Is greater-than-or-equal-to matching correct here?
      #
      if {[isWindows] && [info exists ::tcl_platform(osVersion)] && \
          $::tcl_platform(osVersion) >= 10.0 && \
          [haveTclPlatformOsExtraUpdateName "November Update"]} then {
        #
        # NOTE: We are running on Windows 10, return the special value.
        #
        return 394254; # BUGBUG: November Update only?
      }

      #
      # NOTE: We are not running on Windows 10, return the normal value.
      #
      return 394271
    }

    proc getFrameworkSetup462Value {} {
      #
      # NOTE: Check if we are running on Windows 10 or later.
      #
      # BUGBUG: Is greater-than-or-equal-to matching correct here?
      #
      if {[isWindows] && [info exists ::tcl_platform(osVersion)] && \
          $::tcl_platform(osVersion) >= 10.0 && \
          [haveTclPlatformOsExtraUpdateName "Anniversary Update"]} then {
        #
        # NOTE: We are running on Windows 10, return the special value.
        #
        return 394802; # BUGBUG: Anniversary Update only?
      }

      #
      # NOTE: We are not running on Windows 10, return the normal value.
      #
      return 394806
    }

    proc getFrameworkSetup47Value {} {
      #
      # NOTE: Check if we are running on Windows 10 or later.
      #
      # BUGBUG: Is greater-than-or-equal-to matching correct here?
      #
      if {[isWindows] && [info exists ::tcl_platform(osVersion)] && \
          $::tcl_platform(osVersion) >= 10.0 && \
          [haveTclPlatformOsExtraUpdateName "Creators Update"]} then {
        #
        # NOTE: We are running on Windows 10, return the special value.
        #
        return 460798; # BUGBUG: Creators Update only?
      }

      #
      # NOTE: We are not running on Windows 10, return the normal value.
      #
      return 460805
    }

    proc getFrameworkSetup471Value {} {
      #
      # NOTE: Check if we are running on Windows 10 or later.
      #
      # BUGBUG: Is greater-than-or-equal-to matching correct here?
      #
      if {[isWindows] && [info exists ::tcl_platform(osVersion)] && \
          $::tcl_platform(osVersion) >= 10.0 && \
          [haveTclPlatformOsExtraUpdateName "Fall Creators Update"]} then {
        #
        # NOTE: We are running on Windows 10, return the special value.
        #
        return 461308; # BUGBUG: Fall Creators Update only?
      }

      #
      # NOTE: We are not running on Windows 10, return the normal value.
      #
      return 461310
    }

    proc checkForNetFx4x { channel } {
      tputs $channel "---- checking for .NET Framework 4.x... "

      #
      # NOTE: Platform must be Windows for this constraint to even be
      #       checked (i.e. we require the registry).

          #       is installed.  However, if the "release" value is also
          #       greater than or equal to 379893, then the .NET Framework
          #       4.5.2 is installed, which is an in-place upgrade to 4.5.1
          #       (and 4.5).  If the "release" value is also greater than or
          #       equal to 393297 (393295 on Windows 10), then the .NET
          #       Framework 4.6 is installed, which is an in-place upgrade
          #       to 4.5.x.  Similar handling is necessary for the .NET
          #       Framework 4.6.1, 4.6.2, 4.7, and 4.7.1.  For information,
          #       see:
          #
          #       https://msdn.microsoft.com/en-us/library/hh925568.aspx
          #
          if {$release >= [getFrameworkSetup471Value]} then {
            addConstraint dotNet451OrHigher
            addConstraint dotNet452OrHigher
            addConstraint dotNet46OrHigher
            addConstraint dotNet461OrHigher
            addConstraint dotNet462OrHigher
            addConstraint dotNet47OrHigher
            addConstraint dotNet471
            addConstraint dotNet471OrHigher

            set version 4.7.1
          } elseif {$release >= [getFrameworkSetup47Value]} then {
            addConstraint dotNet451OrHigher
            addConstraint dotNet452OrHigher
            addConstraint dotNet46OrHigher
            addConstraint dotNet461OrHigher
            addConstraint dotNet462OrHigher
            addConstraint dotNet47
            addConstraint dotNet47OrHigher

            set version 4.6
          } elseif {$release >= 379893} then {
            addConstraint dotNet451OrHigher
            addConstraint dotNet452
            addConstraint dotNet452OrHigher

            set version 4.5.2
          } elseif {$release >= [getFrameworkSetup451Value]} then {
            addConstraint dotNet451
            addConstraint dotNet451OrHigher

            set version 4.5.1
          } else {
            addConstraint dotNet45

    # NOTE: We need several of our test constraint related commands in the
    #       global namespace.
    #
    exportAndImportPackageCommands [namespace current] [list \
        getKnownBuildTypes getKnownCompileOptions getKnownMonoVersions \
        addKnownMonoConstraints lpermute alwaysFullInterpReady canExecComSpec \
        canExecWhoAmI canExecTclShell canExecFossil canExecVsWhere isTestMono \
        isTestAdministrator canPing cleanConstraintName cleanPackageName \
        haveTclPlatformOsExtraUpdateName checkForTestSuiteFiles \
        checkForPlatform checkForWindowsVersion checkForOperatingSystemUpdate \
        checkForScriptLibrary checkForVariable checkForTclOptions \
        checkForWindowsCommandProcessor checkForPackage checkForFossil \
        checkForVisualStudioViaVsWhere checkForEagle checkForSymbols \
        checkForLogFile checkForGaruda checkForShell \
        checkForOfficialStableReleaseInProgress checkForDebug checkForTk \
        checkForVersion checkForCommand checkForSubCommand checkForNamespaces \
        checkForTestExec checkForTestMachine checkForTestPlatform \
        checkForTestConfiguration checkForTestSuffix checkForFile \
        checkForPathFile checkForNativeCode checkForTip127 checkForTip194 \
        checkForTip207 checkForTip241 checkForTip285 checkForTip405 \
        checkForTip421 checkForTip426 checkForTip429 checkForTip440 \
        checkForTip461 checkForTip463 checkForTip471 checkForTiming \
        checkForPerformance checkForBigLists checkForProcessorIntensive \
        checkForTimeIntensive checkForFullTest checkForMemoryIntensive \
        checkForStackIntensive checkForStackSize checkForInteractive \
        checkForInteractiveCommand checkForUserInteraction checkForNetwork \
        checkForCompileOption checkForKnownCompileOptions] false false

        #
        if {![info exists no(compileLimitedEdition)]} then {
          #
          # NOTE: This is not currently used by any tests.
          #
          checkForCompileOption $test_channel LIMITED_EDITION
        }

        #
        # NOTE: Has runtime "demo edition" checking support been
        #       disabled (at compile-time)?  This only applies to
        #       third-party plugins and applications.
        #
        if {![info exists no(compileDemoEdition)]} then {
          #
          # NOTE: This is not currently used by any tests.
          #
          checkForCompileOption $test_channel DEMO_EDITION
        }
      }
    }

    #
    # NOTE: Has dynamic loading testing support been disabled?
    #
    if {![info exists no(dynamic)]} then {

        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestRemotingHaveChannel*

        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestRemotingTryGetChannel*
      }

      #
      # NOTE: Has embedded resource testing support been disabled?
      #
      if {![info exists no(testResources)]} then {
        #
        # NOTE: For test "interp-1.400".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestGetResourceString*
      }

      #
      # NOTE: Has asynchronous testing support been disabled?
      #
      if {![info exists no(testAsynchronous)]} then {
        #
        # NOTE: For tests "basic-1.20" and "basic-1.21".
        #

      if {![info exists no(testSetComplain)]} then {
        #
        # NOTE: This is not currently used by any tests.
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestSetComplain*
      }

      #
      # NOTE: Has enumerable variable testing support been disabled?
      #
      if {![info exists no(testEnumerableVariables)]} then {
        #
        # NOTE: For test "basic-1.105".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestSetupIntArray*

        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestSetVariableEnumerable*

        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestUnsetVariableEnumerable*
      }

      #
      # NOTE: Has linked variable testing support been disabled?
      #
      if {![info exists no(testLinkedVariables)]} then {
        #
        # NOTE: For tests "basic-1.39", "basic-1.40", "basic-1.41",

        #
        # NOTE: For tests "object-3.14" and "object-3.15".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestReturnOfSelf*

        #
        # NOTE: For test "object-3.17".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestByRefByteArray*

        #
        # NOTE: For test "object-4.1".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestExpr*

        #

  if {![info exists no(platform)]} then {
    checkForPlatform $test_channel
  }

  if {![info exists no(windowsVersion)]} then {
    checkForWindowsVersion $test_channel
  }

  if {![info exists no(operatingSystemUpdates)]} then {
    if {[isEagle] && [info exists tcl_platform(osExtra)]} then {
      vwaitWithTimeout tcl_platform(osExtra) $test_timeout
    }

    checkForOperatingSystemUpdate $test_channel KB936929
    checkForOperatingSystemUpdate $test_channel KB976932
    checkForOperatingSystemUpdate $test_channel "November Update"
    checkForOperatingSystemUpdate $test_channel "Anniversary Update"
    checkForOperatingSystemUpdate $test_channel "Creators Update"
    checkForOperatingSystemUpdate $test_channel "Fall Creators Update"
  }

  if {![info exists no(scriptLibrary)]} then {
    checkForScriptLibrary $test_channel
  }

  if {![info exists no(tclOptions)]} then {
    checkForTclOptions $test_channel

  if {![info exists no(tip285)]} then {
    checkForTip285 $test_channel
  }

  if {![info exists no(tip405)]} then {
    checkForTip405 $test_channel
  }

  if {![info exists no(tip421)]} then {
    checkForTip421 $test_channel
  }

  if {![info exists no(tip426)]} then {
    checkForTip426 $test_channel
  }

  if {![info exists no(tip429)]} then {
    checkForTip429 $test_channel