###############################################################################
#
# constraints.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Test Constraints File
#
# Copyright (c) 2007-2010 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 checkForPlatform { channel } {
    tputs $channel "---- checking for platform... "

    addConstraint $::tcl_platform(platform)

    if {![isEagle]} then {
      #
      # BUGFIX: We do not want to skip any Mono bugs in Tcl.
      #         Also, fake the culture.
      #
      set constraints [list monoToDo monoBug monoCrash culture.en_US]

      #
      # NOTE: Add the necessary constraints for each version
      #       of Mono we know about.
      #
      foreach version [list 20 22 24 26 28 210 30] {
        addConstraint [appendArgs monoToDo $version]
        addConstraint [appendArgs monoBug $version]
        addConstraint [appendArgs monoCrash $version]
      }

      foreach constraint $constraints {
        addConstraint $constraint; # running in Tcl.
      }
    }

    tputs $channel [appendArgs $::tcl_platform(platform) \n]
  }
 
  proc checkForEagle { channel } {
    tputs $channel "---- checking for Eagle... "

    if {[isEagle]} then {
      #
      # NOTE: We are running inside Eagle.
      #
      addConstraint eagle

      #
      # NOTE: We do not want to skip bugs or crashing
      #       issues for Tcl since we are not running
      #       in Tcl.
      #
      addConstraint tclBug
      addConstraint tclCrash

      #
      # NOTE: Add the necessary constraints for each
      #       version of Tcl we know about.
      #
      foreach version [list 84 85 86] {
        addConstraint [appendArgs tclBug $version]
        addConstraint [appendArgs tclCrash $version]
      }

      tputs $channel yes\n
    } else {
      #
      # NOTE: We are running inside Tcl.
      #
      addConstraint tcl

      #
      # NOTE: Each Tcl bug and crash constraint is set
      #       based on the exact Tcl version (i.e. not
      #       greater than or equal to).
      #
      if {[info exists ::tcl_version]} then {
        #
        # NOTE: For each Tcl version we know about,
        #       check it against the currently running
        #       Tcl version.  If the two are not equal,
        #       add the test constraints that prevent
        #       skipping those tests that are buggy
        #       only for the particular version of Tcl.
        #
        foreach dotVersion [list 8.4 8.5 8.6] {
          if {$::tcl_version ne $dotVersion} then {
            set version [string map [list . ""] $dotVersion]

            addConstraint [appendArgs tclBug $version]
            addConstraint [appendArgs tclCrash $version]
          }
        }
      }

      #
      # NOTE: We do not want to skip bugs or crashing
      #       issues for Eagle since we are not running
      #       in Eagle.
      #
      addConstraint eagleBug
      addConstraint eagleCrash

      tputs $channel no\n
    }
  }
 
  proc checkForGaruda { channel } {
    tputs $channel "---- checking for Garuda... "

    if {[haveGaruda packageId]} then {
      #
      # NOTE: We are running with or via Garuda.
      #
      addConstraint garuda

      tputs $channel [appendArgs "yes (" $packageId ")\n"]
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForShell { channel } {
    tputs $channel "---- checking for shell... "

    set name [file rootname [file tail [info nameofexecutable]]]

    if {[isEagle]} then {
      if {$name eq "EagleShell"} then {
        #
        # NOTE: We are running in Eagle via the EagleShell.
        #
        addConstraint shell

        tputs $channel "yes (Eagle)\n"

        #
        # NOTE: We are done here, return now.
        #
        return
      }
    } else {
      if {[string match tclsh* $name]} then {
        #
        # NOTE: We are running in Tcl via tclsh.
        #
        addConstraint shell

        tputs $channel "yes (Tcl)\n"

        #
        # NOTE: We are done here, return now.
        #
        return
      }
    }

    tputs $channel no\n
  }
 
  proc checkForDebug { channel } {
    tputs $channel "---- checking for debug... "

    if {[info exists ::tcl_platform(debug)] && $::tcl_platform(debug)} then {
      addConstraint debug

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForVersion { channel } {
    tputs $channel "---- checking for language version... "

    if {[info exists ::tcl_version]} then {
      #
      # TODO: Cleanup the semantics for adding test
      #       constraints here.
      #
      if {$::tcl_version eq "8.4"} then {
        #
        # NOTE: Baseline reported language and feature
        #       version.
        #
        addConstraint tcl84
        addConstraint tcl84OrHigher
        addConstraint tcl84Feature

        if {[isEagle]} then {
          #
          # NOTE: *EAGLE* We do want to include any
          #       tests that target "Tcl 8.5 or higher"
          #       features and/or "Tcl 8.6 or higher"
          #       features because they would not be in
          #       the test suite if we did not support
          #       that particular feature, regardless
          #       of the language version.
          #
          addConstraint tcl85Feature
          addConstraint tcl86Feature
        }
      } elseif {$::tcl_version eq "8.5"} then {
        #
        # NOTE: Baseline reported language and feature
        #       version.  Tcl 8.5 includes all the
        #       features from itself and Tcl 8.4.
        #
        addConstraint tcl85
        addConstraint tcl84OrHigher
        addConstraint tcl85OrHigher
        addConstraint tcl84Feature
        addConstraint tcl85Feature

        if {[isEagle]} then {
          #
          # NOTE: *EAGLE* We do want to include any
          #       tests that target "Tcl 8.5 or higher"
          #       features and/or "Tcl 8.6 or higher"
          #       features because they would not be in
          #       the test suite if we did not support
          #       that particular feature, regardless
          #       of the language version.
          #
          addConstraint tcl86Feature
        }
      } elseif {$::tcl_version eq "8.6"} then {
        #
        # NOTE: Baseline reported language and feature
        #       version.  Tcl 8.6 includes all the
        #       features from itself Tcl 8.4, and Tcl
        #       8.5.
        #
        addConstraint tcl86
        addConstraint tcl84OrHigher
        addConstraint tcl85OrHigher
        addConstraint tcl86OrHigher
        addConstraint tcl84Feature
        addConstraint tcl85Feature
        addConstraint tcl86Feature
      }

      tputs $channel [appendArgs $::tcl_version \n]
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForCommand { channel name } {
    tputs $channel [appendArgs "---- checking for command \"" $name \
        "\"... "]

    #
    # NOTE: Is the command available?
    #
    if {[llength [info commands $name]] > 0} then {
      #
      # NOTE: Yes, it appears that it is available.
      #
      addConstraint command.$name

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForFile { channel name {constraint ""} } {
    tputs $channel [appendArgs "---- checking for file \"" $name \
        "\"... "]

    if {[file exists $name]} then {
      #
      # NOTE: Yes, it appears that it is available.
      #
      if {[string length $constraint] > 0} then {
        addConstraint file_$constraint
      } else {
        addConstraint file_[file tail $name]
      }

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForPathFile { channel name {constraint ""} } {
    tputs $channel [appendArgs "---- checking for file \"" $name \
        "\" along PATH... "]

    if {[file exists $name]} then {
      #
      # NOTE: Yes, it appears that it is available [in the exact location they
      #       specified].
      #
      if {[string length $constraint] > 0} then {
        addConstraint file_$constraint
      } else {
        addConstraint file_[file tail $name]
      }

      tputs $channel yes\n

      #
      # NOTE: We are done here, return now.
      #
      return
    } else {
      #
      # NOTE: Use the appropriate environment variable for the platform.
      #
      if {$::tcl_platform(platform) eq "windows"} then {
        set pathName PATH
      } else {
        #
        # HACK: For shared libraries, use the LD_LIBRARY_PATH.
        #
        if {[file extension $name] eq [info sharedlibextension]} then {
          set pathName LD_LIBRARY_PATH
        } else {
          set pathName PATH
        }
      }

      #
      # NOTE: Is the required environment variable available?
      #
      if {[info exists ::env($pathName)]} then {
        #
        # NOTE: Ok, grab it now.
        #
        set path $::env($pathName)

        #
        # NOTE: Use the appropriate path separator for the platform.
        #
        if {[info exists ::tcl_platform(pathSeparator)]} then {
          set separator $::tcl_platform(pathSeparator)
        } elseif {$::tcl_platform(platform) eq "windows"} then {
          set separator \;
        } else {
          set separator :
        }

        #
        # NOTE: Grab just the file name from the possibly fully qualified file
        #       name provided by the caller.
        #
        set tail [file tail $name]

        #
        # NOTE: Check each directory in the PATH for the file.
        #
        foreach directory [split $path $separator] {
          #
          # NOTE: Check for the file in this directory contained in the PATH.
          #       This strips the directory portion off the file name specified
          #       by the caller, if any, before joining that file name to the
          #       current directory of the PATH being searched.
          #
          if {[file exists [file join $directory $tail]]} then {
            #
            # NOTE: Yes, it appears that it is available in the PATH.
            #
            if {[string length $constraint] > 0} then {
              addConstraint file_$constraint
            } else {
              addConstraint file_[file tail $name]
            }

            tputs $channel yes\n

            #
            # NOTE: We are done here, return now.
            #
            return
          }
        }
      }
    }

    tputs $channel no\n
  }
 
  proc checkForNativeCode { channel } {
    tputs $channel "---- checking for native code... "

    if {[isEagle]} then {
      if {[info exists ::eagle_platform(compileOptions)] && \
          [info exists ::tcl_platform(platform)] && \
          [lsearch -exact -nocase $::eagle_platform(compileOptions) \
          $::tcl_platform(platform)] != -1} then {
        #
        # NOTE: Yes, the binary matches the current platform,
        #       native code can be used.
        #
        addConstraint native

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    } else {
      #
      # NOTE: Tcl is always native code and can always execute native code.
      #
      addConstraint native

      #
      # HACK: Needed by test "benchmark-1.22".
      #
      addConstraint compile.NATIVE

      tputs $channel yes\n
    }
  }
 
  proc checkForTip127 { channel } {
    tputs $channel "---- checking for TIP #127... "

    #
    # NOTE: Is the interpreter TIP #127 ready?
    #
    if {[catch {lsearch -index 0 0 0}] == 0} then {
      addConstraint tip127

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

    #
    # NOTE: Is the interpreter TIP #194 ready?
    #
    catch {apply} error

    if {$error ne {invalid command name "apply"}} then {
      addConstraint tip194

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

    #
    # NOTE: Is the interpreter TIP #241 ready?
    #
    if {[catch {lsearch -nocase 0 0}] == 0} then {
      addConstraint tip241

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

    #
    # NOTE: Is the interpreter TIP #285 ready?
    #
    catch {interp cancel} error

    if {$error eq "eval canceled"} then {
      addConstraint tip285

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

    #
    # NOTE: Are we allowed to do precision timing tests?
    #
    if {![info exists ::no(timing)]} then {
      #
      # 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 {
        addConstraint timing

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

    #
    # NOTE: Are we allowed to do performance testing?
    #
    if {![info exists ::no(performance)]} then {
      addConstraint performance

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForInteractive { channel } {
    tputs $channel "---- checking for interactive user... "

    #
    # NOTE: Is there an interactive user?
    #
    if {[info exists ::tcl_interactive] && $::tcl_interactive} then {
      addConstraint interactive

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForUserInteraction { channel } {
    tputs $channel "---- checking for user interaction... "

    #
    # HACK: For now, do the exact same check as checkForInteractive; however,
    #       this is still useful as a separate constraint because it can be
    #       individually disabled in "prologue.eagle".
    #
    if {[info exists ::tcl_interactive] && $::tcl_interactive} then {
      addConstraint userInteraction

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForNetwork { channel host timeout } {
    tputs $channel [appendArgs \
        "---- checking for network connectivity to host \"" $host "\"... "]

    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 {[llength [info commands uri]] > 0 && \
          [catch {uri ping $host $timeout} response] == 0 && \
          [lindex $response 0] in [list Success TimedOut] && \
          [string is integer -strict [lindex $response 1]] && \
          [lindex $response 1] <= $timeout}

      #
      # NOTE: Does it look like we are able to contact the network host?
      #
      if {[expr $expr]} then {
        #
        # NOTE: Yes, it appears that it is available.
        #
        addConstraint network_$host

        tputs $channel [appendArgs "yes (" $response ")\n"]
      } else {
        tputs $channel no\n
      }
    } else {
      #
      # HACK: Running in Tcl, just assume we have network access.
      #
      addConstraint network_$host

      tputs $channel yes\n
    }
  }
 
  if {[isEagle]} then {
    ###########################################################################
    ############################ BEGIN Eagle ONLY #############################
    ###########################################################################

    proc checkForSoftwareUpdateTrust { channel } {
      tputs $channel "---- checking for software update trust... "

      if {[llength [info commands uri]] > 0 && \
          [catch {uri softwareupdates} result] == 0 && \
          $result eq "software update certificate is trusted"} then {
        #
        # NOTE: Yes, it appears that we trust our software updates.
        #       Since this setting is off by default, the user (or
        #       a script evaluated by the user) must have manually
        #       turned it on.
        #
        addConstraint softwareUpdate

        tputs $channel "trusted\n"
      } else {
        tputs $channel "untrusted\n"
      }
    }
 
    proc checkForAdministrator { channel } {
      tputs $channel "---- checking for administrator... "

      if {[isAdministrator]} then {
        addConstraint administrator; # running as full admin.

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForHost { channel } {
      tputs $channel "---- checking for host... "

      if {[set code [catch {host isopen} result]] == 0 && $result} then {
        addConstraint hostIsOpen

        tputs $channel open\n
      } elseif {$code == 0} then {
        tputs $channel closed\n
      } else {
        tlog $result; tputs $channel error\n]
      }
    }
 
    proc checkForPrimaryThread { channel } {
      tputs $channel "---- checking for primary thread... "

      set threadId [object invoke Interpreter.GetActive ThreadId]

      if {[info tid] == $threadId} then {
        addConstraint primaryThread

        tputs $channel [appendArgs "yes (" $threadId ")\n"]
      } else {
        tputs $channel [appendArgs "no (" $threadId ")\n"]
      }
    }
 
    proc checkForRuntime { channel } {
      tputs $channel "---- checking for runtime... "

      #
      # NOTE: Are we running inside Mono (regardless of operating system)?
      #
      if {[isMono]} then {
        #
        # NOTE: Yes, it appears that we are running inside Mono.
        #
        addConstraint mono; # running on Mono.

        tputs $channel [appendArgs [expr {[info exists \
            ::eagle_platform(runtime)] ? \
            $::eagle_platform(runtime) : "Mono"}] \n]
      } else {
        #
        # NOTE: No, it appears that we are not running inside Mono.
        #
        addConstraint dotNet; # running on .NET.

        #
        # NOTE: We do not want to skip Mono bugs on .NET.
        #
        addConstraint monoToDo; # running on .NET.
        addConstraint monoBug; # running on .NET.
        addConstraint monoCrash; # running on .NET.

        tputs $channel [appendArgs [expr {[info exists \
            ::eagle_platform(runtime)] ? \
            $::eagle_platform(runtime) : "Microsoft.NET"}] \n]
      }
    }
 
    proc checkForImageRuntimeVersion { channel } {
      tputs $channel "---- checking for image runtime version... "

      if {[info exists ::eagle_platform(imageRuntimeVersion)] && \
          [string length $::eagle_platform(imageRuntimeVersion)] > 0} then {
        #
        # NOTE: Get the major and minor portions of the version only.
        #
        set dotVersion [join [lrange [split \
            $::eagle_platform(imageRuntimeVersion) .] 0 1] .]

        #
        # NOTE: Now create a version string for use in the constraint name
        #       (remove the periods).
        #
        set version [string map [list v "" . ""] $dotVersion]

        #
        # NOTE: Keep track of the specific image runtime version for usage in
        #       test constraints.
        #
        addConstraint imageRuntime$version

        tputs $channel [appendArgs $::eagle_platform(imageRuntimeVersion) \
            " " ( $dotVersion ) \n]
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForRuntimeVersion { channel } {
      tputs $channel "---- checking for runtime version... "

      if {[info exists ::eagle_platform(runtimeVersion)] && \
          [string length $::eagle_platform(runtimeVersion)] > 0} then {
        #
        # NOTE: Get the major and minor portions of the version only.
        #
        set dotVersion [join [lrange [split \
            $::eagle_platform(runtimeVersion) .] 0 1] .]

        #
        # NOTE: Now create a version string for use in the constraint name
        #       (remove the periods).
        #
        set version [string map [list . ""] $dotVersion]

        if {[isMono]} then {
          if {[string length $version] > 0} then {
              #
              # NOTE: We are running on Mono.  Keep track of the specific
              #       version for usage in test constraints.
              #
              addConstraint mono$version
          }

          if {[string length $dotVersion] > 0 && \
              [regexp -- {^(\d+)\.(\d+)$} $dotVersion dummy \
                  majorVersion minorVersion]} then {
            set monoVersions [list]

            #
            # NOTE: Check for any Mono version 2.x or higher.
            #
            if {$majorVersion >= 2} then {
              #
              # NOTE: Check for any Mono version higher than 2.0.
              #
              if {$majorVersion > 2 || $minorVersion > 0} then {
                lappend monoVersions 20
              }

              #
              # NOTE: Check for any Mono version higher than 2.2.
              #
              if {$majorVersion > 2 || $minorVersion > 2} then {
                lappend monoVersions 22
              }

              #
              # NOTE: Check for any Mono version higher than 2.4.
              #
              if {$majorVersion > 2 || $minorVersion > 4} then {
                lappend monoVersions 24
              }

              #
              # NOTE: Check for any Mono version higher than 2.6.
              #
              if {$majorVersion > 2 || $minorVersion > 6} then {
                lappend monoVersions 26
              }

              #
              # NOTE: Check for any Mono version higher than 2.8.
              #
              if {$majorVersion > 2 || $minorVersion > 8} then {
                lappend monoVersions 28
              }

              #
              # NOTE: Check for any Mono version higher than 2.10.
              #
              if {$majorVersion > 2 || $minorVersion > 10} then {
                lappend monoVersions 210
              }
            }

            #
            # NOTE: Check for any Mono version 3.x or higher.
            #
            if {$majorVersion >= 3} then {
              #
              # NOTE: Check for any Mono version higher than 3.0.
              #
              if {$majorVersion > 3 || $minorVersion > 0} then {
                lappend monoVersions 30
              }
            }

            #
            # NOTE: Add the necessary constraints for each version of Mono we
            #       should NOT skip bugs for.
            #
            foreach monoVersion $monoVersions {
              addConstraint [appendArgs monoToDo $monoVersion]
              addConstraint [appendArgs monoBug $monoVersion]
              addConstraint [appendArgs monoCrash $monoVersion]
            }
          }
        } else {
          if {[string length $version] > 0} then {
            #
            # NOTE: We are running on the .NET Framework.  Keep track of the
            #       specific version for usage in test constraints.
            #
            addConstraint dotNet$version
          }

          #
          # NOTE: We do not want to skip any Mono bugs on .NET.  Add the
          #       necessary constraints for each version of Mono we know
          #       about.
          #
          foreach monoVersion [list 20 22 24 26 28 210 30] {
            addConstraint [appendArgs monoToDo $monoVersion]
            addConstraint [appendArgs monoBug $monoVersion]
            addConstraint [appendArgs monoCrash $monoVersion]
          }
        }

        tputs $channel [appendArgs $::eagle_platform(runtimeVersion) \
            " " ( $dotVersion ) \n]
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForMachine { channel bits machine } {
      tputs $channel [appendArgs "---- checking for machine \"" $bits \
          "-bit " $machine "\"... "]

      #
      # NOTE: What are the machine architecture and the
      #       number of bits for this operating system?
      #
      if {[info exists ::tcl_platform(machine)] && \
          [info exists ::tcl_platform(osBits)]} then {
        #
        # NOTE: Does the machine and number of bits match
        #       what the caller specified?
        #
        if {$::tcl_platform(machine) eq $machine && \
            $::tcl_platform(osBits) eq $bits} then {
          #
          # NOTE: Yes, it matches.
          #
          addConstraint $machine.${bits}bit

          set result yes
        } else {
          set result no
        }

        tputs $channel [appendArgs $result ", " $::tcl_platform(osBits) -bit \
            " " $::tcl_platform(machine)\n]
      } else {
        tputs $channel "no, unknown\n"
      }
    }
 
    proc checkForGarudaDll { channel } {
      #
      # NOTE: Check for the Garuda DLL of the same platform (i.e. machine
      #       type) as the native Tcl shell.
      #
      return [checkForFile $channel [file join $::base_path bin \
          [machineToPlatform [getMachineForTclShell]] \
          [appendArgs $::eagle_platform(configuration) Dll] \
          [appendArgs Garuda [info sharedlibextension]]]]
    }
 
    proc checkForCulture { channel } {
      tputs $channel "---- checking for culture... "

      #
      # NOTE: Grab the current culture.
      #
      set culture [info culture]

      if {[string length $culture] > 0} then {
        #
        # NOTE: The culture information is present, use it and show it.
        #
        addConstraint culture.[string map [list - _] $culture]

        tputs $channel [appendArgs $culture \n]
      } else {
        tputs $channel [appendArgs unknown \n]
      }
    }
 
    proc checkForReferenceCountTracking { channel } {
      tputs $channel "---- checking for object reference count tracking... "

      if {[info exists ::eagle_platform(compileOptions)] && \
          ([lsearch -exact -nocase $::eagle_platform(compileOptions) \
              NOTIFY] != -1 || \
           [lsearch -exact -nocase $::eagle_platform(compileOptions) \
              NOTIFY_OBJECT] != -1)} then {
        #
        # NOTE: Yes, support for object reference count tracking is present.
        #
        addConstraint refCount

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForCompileOption { channel option } {
      tputs $channel [appendArgs "---- checking for compile option \"" \
          $option "\"... "]

      if {[info exists ::eagle_platform(compileOptions)] && \
          [lsearch -exact -nocase $::eagle_platform(compileOptions) \
              $option] != -1} then {
        #
        # NOTE: Yes, support for the compile option is present.
        #
        addConstraint compile.$option

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForRuntimeOption { channel option } {
      tputs $channel [appendArgs "---- checking for runtime option \"" \
          $option "\"... "]

      if {[info exists ::eagle_platform(runtimeOptions)] && \
          [lsearch -exact -nocase $::eagle_platform(runtimeOptions) \
              $option] != -1} then {
        #
        # NOTE: Yes, support for the runtime option is present.
        #
        addConstraint runtime.$option

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForDynamicLoading { channel } {
      tputs $channel "---- checking for dynamic loading... "

      #
      # NOTE: As far as we know, dynamic loading always works on Windows.
      #       On some Unix systems, dlopen does not work (e.g. because
      #       Mono is statically linked, etc).
      #
      if {$::tcl_platform(platform) eq "windows" || \
          ([llength [info commands library]] > 0 && \
           [catch {library test}] == 0)} then {
        #
        # NOTE: Yes, it appears that it is available.
        #
        addConstraint dynamic

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForWindowsForms { channel } {
      tputs $channel "---- checking for Windows Forms... "

      #
      # HACK: When running on Windows, we do not need to do any other
      #       special checks here; however, on Unix (and Mac OS X?),
      #       we should check for the DISPLAY environment variable as
      #       some basic indication that the X server is available.
      #       This appears to be very necessary on Mono because it
      #       crashes after repeated failed attempts to create a
      #       Windows Form when the X server is unavailable (e.g. on
      #       OpenBSD).
      #
      if {$::tcl_platform(platform) eq "windows" || \
          [info exists ::env(DISPLAY)]} then {
        #
        # NOTE: Is the Windows Forms assembly available?
        #
        if {[catch {object resolve System.Windows.Forms} assembly] == 0} then {
          #
          # NOTE: Yes, it appears that it is available.
          #
          addConstraint winForms

          tputs $channel yes\n

          #
          # NOTE: We are done here, return now.
          #
          return
        }
      }

      tputs $channel no\n
    }
 
    proc checkForStaThread { channel } {
      tputs $channel "---- checking for STA thread... "

      if {[catch {object invoke System.Threading.Thread.CurrentThread \
              GetApartmentState} apartmentState] == 0 && \
          $apartmentState eq "STA"} then {
        #
        # NOTE: Yes, we are running in an STA thread.
        #
        addConstraint staThread

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForWindowsPresentationFoundation { channel } {
      tputs $channel "---- checking for Windows Presentation Foundation... "

      #
      # NOTE: Is the Windows Presentation Foundation available?
      #
      if {[catch {object resolve PresentationFramework} assembly] == 0} then {
        #
        # NOTE: Yes, it appears that it is available.
        #
        addConstraint wpf

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForDatabase { channel string } {
      tputs $channel "---- checking for database... "

      #
      # HACK: Disable database connectivity testing on Mono because
      #       it fails to timeout (unless special test suite hacks
      #       for Mono have been disabled by the user).
      #
      if {[info exists ::no(mono)] || ![isMono]} then {
        #
        # NOTE: Can we access the local database?
        #
        if {[catch {sql open $string} connection] == 0} then {
          #
          # NOTE: Yes, it appears that we can connect to the local database.
          #
          addConstraint sql

          #
          # NOTE: Cleanup the database connection we just opened.
          #
          sql close $connection

          tputs $channel yes\n
        } else {
          tputs $channel no\n
        }
      } else {
        tputs $channel "disabled\n"
      }
    }
 
    proc checkForAssembly { channel name } {
      tputs $channel [appendArgs "---- checking for assembly \"" $name \
          "\"... "]

      #
      # NOTE: Can the assembly be loaded?
      #
      if {[catch {object resolve $name} assembly] == 0} then {
        #
        # NOTE: Yes, it appears that it is available.
        #
        addConstraint $name

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForObjectMember { channel object member } {
      tputs $channel [appendArgs "---- checking for object member \"" \
          $object . $member "\"... "]

      if {[catch {object members -flags +NonPublic -pattern $member $object} \
          members] == 0 && [llength $members] > 0} then {
        #
        # NOTE: Yes, it appears that it is available.
        #
        addConstraint $object.[string trim $member *?]

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForTclInstalls { channel } {
      tputs $channel "---- checking for Tcl installs... "

      #
      # NOTE: Check for dynamically loadable Tcl libraries (for this
      #       architecture only).
      #
      if {[catch {tcl select -architecture} tcl] == 0} then {
        #
        # NOTE: Did we find one?  Attempt to grab the index
        #       of the version field from the list.
        #
        set index [lsearch -exact $tcl version]

        if {$index != -1} then {
          #
          # NOTE: The very next list index contains the value
          #       (i.e. like a Tcl 8.5+ dict).
          #
          set dotVersion [lindex $tcl [incr index]]

          #
          # NOTE: Do we know the version?
          #
          if {[string length $dotVersion] > 0 && \
              [regexp -- {^\d+\.\d+$} $dotVersion]} then {
            #
            # NOTE: Yes, some version of Tcl is available.
            #
            addConstraint tclLibrary

            #
            # NOTE: Is the version 8.x or higher?
            #
            if {$dotVersion >= 8.6} then {
              addConstraint tclLibrary86
            } elseif {$dotVersion >= 8.5} then {
              addConstraint tclLibrary85
            } elseif {$dotVersion >= 8.4} then {
              addConstraint tclLibrary84
            }

            tputs $channel [appendArgs $dotVersion \n]

            #
            # NOTE: We are done here, return now.
            #
            return
          }
        }
      }

      tputs $channel no\n
    }
 
    proc checkForTclReady { channel } {
      tputs $channel "---- checking for Tcl readiness... "

      if {[catch {tcl ready} result] == 0 && $result} then {
        #
        # NOTE: Yes, native Tcl is loaded and ready.
        #
        addConstraint tclReady

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForTclShell { channel } {
      #
      # HACK: We do not care about the machine type returned from this
      #       procedure, we only care if it returns "error" because that
      #       would indicate an error was caught during [exec] (i.e. the
      #       native Tcl shell could not be executed).
      #
      if {[catch {getMachineForTclShell} result] == 0 && \
          $result ne "error"} then {
        #
        # NOTE: Yes, a native Tcl shell appears to be available.
        #
        addConstraint tclShell

        tputs $channel "---- checking for Tcl shell... yes\n"
      } else {
        tputs $channel "---- checking for Tcl shell... no\n"
      }
    }
 
    proc checkForPowerShell { channel } {
      tputs $channel "---- checking for PowerShell... "

      #
      # NOTE: Can the PowerShell assembly be loaded?
      #
      if {[catch {object resolve System.Management.Automation} \
              assembly] == 0} then {
        #
        # NOTE: Yes, it appears that it is available.
        #
        addConstraint powerShell

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForWix { channel } {
      tputs $channel "---- checking for WiX... "

      #
      # NOTE: Platform must be Windows for this constraint to
      #       even be checked (i.e. we require the registry).
      #
      if {$::tcl_platform(platform) eq "windows"} then {
        #
        # NOTE: Indicate that we have not found it yet.
        #
        set directory ""

        #
        # NOTE: Have we not found the directory yet?
        #
        #       Yes, this is somewhat redundant because we just set
        #       the directory to an empty string (above); however,
        #       maintaining a uniform pattern is more important.
        #
        if {[string length $directory] == 0} then {
          #
          # NOTE: Check for the WIX environment variable.
          #
          if {[info exists ::env(WIX)]} then {
            set directory [file normalize [string trimright $::env(WIX)]]

            if {[string length $directory] > 0} then {
              #
              # NOTE: We need the directory containing the binaries.
              #
              set directory [file join $directory bin]

              #
              # NOTE: Does the directory actually exist?
              #
              if {[file isdirectory $directory]} then {
                #
                # NOTE: The file name of the primary WiX assembly.
                #
                set fileName [file join $directory wix.dll]

                #
                # NOTE: We do not know the file version yet.
                #
                set version ""

                #
                # NOTE: Attempt to query the version of the file.
                #
                if {[catch {file version $fileName} version] == 0 && \
                    [string length $version] > 0} then {
                  #
                  # NOTE: Indicate where we found the file.
                  #
                  set where environment
                } else {
                  #
                  # NOTE: The file does not exist or is not properly
                  #       versioned.
                  #
                  set directory ""
                }
              } else {
                #
                # NOTE: The directory does not exist.
                #
                set directory ""
              }
            }
          }
        }

        #
        # NOTE: Have we not found the directory yet?
        #
        if {[string length $directory] == 0} then {
          #
          # NOTE: Registry hive where WiX install information
          #       is stored.
          #
          set key {HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows Installer XML}

          #
          # NOTE: The versions of WiX that we support.
          #
          set versions [list 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 registry, removing the
            #       trailing backslash, if any.
            #
            set directory [file normalize [string trimright [object invoke \
                Microsoft.Win32.Registry GetValue \
                [appendArgs $key \\ $version] InstallRoot \
                null] \\]]

            #
            # NOTE: Does the directory name look valid and
            #       does it actually exist?
            #
            if {[string length $directory] > 0} then {
              #
              # NOTE: Does the directory actually exist?
              #
              if {[file isdirectory $directory]} then {
                #
                # NOTE: The file name of the primary WiX assembly.
                #
                set fileName [file join $directory wix.dll]

                #
                # NOTE: We do not know the file version yet.
                #
                set version ""

                #
                # NOTE: Attempt to query the version of the file.
                #
                if {[catch {file version $fileName} version] == 0 && \
                    [string length $version] > 0} then {
                  #
                  # NOTE: Indicate where we found the file.
                  #
                  set where registry

                  #
                  # NOTE: We found it, bail out now.
                  #
                  break
                } else {
                  #
                  # NOTE: The file does not exist or is not properly
                  #       versioned.
                  #
                  set directory ""
                }
              } else {
                #
                # NOTE: The directory does not exist.
                #
                set directory ""
              }
            }
          }
        }

        #
        # NOTE: Did we find the directory?
        #
        if {[string length $directory] > 0 && \
            [file isdirectory $directory]} then {
          #
          # NOTE: Yes, it appears that it is available.
          #
          addConstraint wix

          #
          # NOTE: Save the directory for later usage by
          #       the test itself.
          #
          set ::test_wix $directory

          #
          # NOTE: Show where we found it.
          #
          tputs $channel [appendArgs "yes (" $version ", via " $where ", \"" \
              $directory "\")\n"]

          #
          # NOTE: We are done here, return now.
          #
          return
        }
      }

      tputs $channel no\n
    }
 
    proc checkForManagedDebugger { channel } {
      tputs $channel "---- checking for managed debugger... "

      #
      # NOTE: Is the managed debugger attached?
      #
      if {[object invoke System.Diagnostics.Debugger IsAttached]} then {
        #
        # NOTE: Yes, it appears that it is attached.
        #
        addConstraint managedDebugger

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

      #
      # NOTE: Is the script debugger available?
      #
      if {[catch {object invoke -flags +NonPublic Interpreter.GetActive \
              Debugger} debugger] == 0} then {
        #
        # NOTE: We do not own this, do not dispose it.
        #
        if {[string length $debugger] > 0} then {
          object flags $debugger +NoDispose
        }

        if {[regexp -- {^Debugger#\d+$} $debugger]} then {
          #
          # NOTE: Yes, it appears that it is available.
          #
          addConstraint scriptDebugger

          tputs $channel yes\n

          #
          # NOTE: We are done here, return now.
          #
          return
        }
      }

      tputs $channel no\n
    }
 
    proc checkForScriptDebuggerInterpreter { channel } {
      tputs $channel "---- checking for script debugger interpreter... "

      #
      # NOTE: Is the script debugger interpreter available?
      #
      if {[catch {object invoke -flags +NonPublic Interpreter.GetActive \
              Debugger} debugger] == 0} then {
        #
        # NOTE: We do not own this, do not dispose it.
        #
        if {[string length $debugger] > 0} then {
          object flags $debugger +NoDispose
        }

        if {[regexp -- {^Debugger#\d+$} $debugger] && \
            [catch {object invoke $debugger Interpreter} interp] == 0} then {
          #
          # NOTE: We do not own this, do not dispose it.
          #
          if {[string length $interp] > 0} then {
            object flags $interp +NoDispose
          }

          if {[regexp -- {^Interpreter#\d+$} $interp]} then {
            #
            # NOTE: Yes, it appears that it is available.
            #
            addConstraint scriptDebuggerInterpreter

            tputs $channel yes\n

            #
            # NOTE: We are done here, return now.
            #
            return
          }
        }
      }

      tputs $channel no\n
    }

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

    #
    # NOTE: We need several of our test constraint related commands in the
    #       global namespace.
    #
    exportAndImportPackageCommands [namespace current] [list checkForPlatform \
        checkForEagle checkForGaruda checkForShell checkForDebug \
        checkForVersion checkForCommand checkForFile checkForNativeCode \
        checkForTip127 checkForTip194 checkForTip241 checkForTip285 \
        checkForPerformance checkForTiming checkForInteractive \
        checkForUserInteraction checkForNetwork] 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}]
}
 

###############################################################################
#
# epilogue.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Test Epilogue File
#
# Copyright (c) 2007-2010 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: $
#
###############################################################################

if {![info exists no([file tail [info script]])]} then {
  if {[info level] > 0} then {
    error "cannot run, current level is not global"
  }

  if {[isEagle]} then {
    #
    # NOTE: Show the current state of the memory.
    #
    tputs $test_channel [appendArgs "---- ending memory: " \
        [formatListAsDict [debug memory]] \n]

    #
    # NOTE: Show the current state of the native stack.
    #
    catch {debug stack true} stack

    tputs $test_channel [appendArgs "---- ending stack: " \
        [formatListAsDict $stack] \n]

    unset stack
  }

  #
  # NOTE: Show when the tests actually ended (now).
  #
  tputs $test_channel [appendArgs "---- tests ended at " \
      [clock format [clock seconds]] \n]

  if {[isEagle]} then {
    tputs $test_channel \n; # NOTE: Blank line.

    if {$eagle_tests(passed) > 0} then {
      host result Ok [appendArgs "PASSED: " $eagle_tests(passed) \n]
      tlog [appendArgs "PASSED: " $eagle_tests(passed) \n]
    }

    if {$eagle_tests(failed) > 0} then {
      host result Error [appendArgs "FAILED: " $eagle_tests(failed) \n]
      tlog [appendArgs "FAILED: " $eagle_tests(failed) \n]

      if {[llength $eagle_tests(failedNames)] > 0} then {
        host result Error [appendArgs "FAILED: " $eagle_tests(failedNames) \n]
        tlog [appendArgs "FAILED: " $eagle_tests(failedNames) \n]
      }
    }

    if {$eagle_tests(skipped) > 0} then {
      host result Break [appendArgs "SKIPPED: " $eagle_tests(skipped) \n]
      tlog [appendArgs "SKIPPED: " $eagle_tests(skipped) \n]
    }

    if {$eagle_tests(total) > 0} then {
      host result Return [appendArgs "TOTAL: " $eagle_tests(total) \n]
      tlog [appendArgs "TOTAL: " $eagle_tests(total) \n]

      #
      # HACK: Temporarily modify the floating point precision so that the
      #       pass percentage does not end up with excessive detail.  In
      #       theory, we could use [string format] here; however, that
      #       would fail under Mono.
      #
      if {$tcl_precision != 4} then {
        set tcl_precision_save $tcl_precision
        set tcl_precision 4
      }

      if {$eagle_tests(skipped) > 0} then {
        set percent [getSkipPercentage]
        host result Break [appendArgs "SKIP PERCENTAGE: " $percent %\n]
        tlog [appendArgs "SKIP PERCENTAGE: " $percent %\n]
      }

      set percent [getPassPercentage]
      host result Return [appendArgs "PASS PERCENTAGE: " $percent %\n]
      tlog [appendArgs "PASS PERCENTAGE: " $percent% \n]

      #
      # NOTE: Restore the saved floating point precision.
      #
      if {[info exists tcl_precision_save]} then {
        set tcl_precision $tcl_precision_save
        unset tcl_precision_save
      }
    } else {
      #
      # NOTE: No tests.
      #
      set percent 0
    }

    #
    # NOTE: Has the test pass threshold been set?  If so, is it set to
    #       the default value?
    #
    if {![info exists test_threshold] || $test_threshold == 100} then {
      #
      # NOTE: The test pass threshold is set to the default value (100%).
      #       Check to make sure that all tests pass and then set the
      #       exit code to success; otherwise, we set it to failure.
      #
      set passedOrSkipped [expr {$eagle_tests(passed) + \
          $eagle_tests(skipped)}]

      if {$passedOrSkipped == $eagle_tests(total)} then {
        set exitCode Success

        host result Ok "OVERALL RESULT: SUCCESS\n"
        tlog "OVERALL RESULT: SUCCESS\n"
      } else {
        set exitCode Failure

        host result Error "OVERALL RESULT: FAILURE\n"
        tlog "OVERALL RESULT: FAILURE\n"
      }

      unset passedOrSkipped
    } else {
      #
      # NOTE: They specified a non-default test pass threshold.  Check to
      #       make sure that we meet or exceed the requirement and then
      #       set the exit code to success; otherwise, set it to failure.
      #
      if {$percent >= $test_threshold} then {
        set exitCode Success

        host result Ok [appendArgs "OVERALL RESULT: SUCCESS (" \
            $percent "% >= " $test_threshold %)\n]

        tlog [appendArgs "OVERALL RESULT: SUCCESS (" \
            $percent "% >= " $test_threshold %)\n]
      } else {
        set exitCode Failure

        host result Error [appendArgs \
            "OVERALL RESULT: FAILURE (" $percent "% < " $test_threshold %)\n]

        tlog [appendArgs \
            "OVERALL RESULT: FAILURE (" $percent "% < " $test_threshold %)\n]
      }
    }

    unset percent

    tputs $test_channel \n; # NOTE: Blank line.
  } else {
    tputs $test_channel \n; # NOTE: Blank line.

    if {$::tcltest::numTests(Passed) > 0} then {
      tputs $test_channel \
          [appendArgs "PASSED: " $::tcltest::numTests(Passed) \n]
    }

    if {$::tcltest::numTests(Failed) > 0} then {
      tputs $test_channel \
          [appendArgs "FAILED: " $::tcltest::numTests(Failed) \n]

      if {[llength $::tcltest::failFiles] > 0} then {
        tputs $test_channel \
            [appendArgs "FAILED: " $::tcltest::failFiles \n]
      }
    }

    if {$::tcltest::numTests(Skipped) > 0} then {
      tputs $test_channel \
          [appendArgs "SKIPPED: " $::tcltest::numTests(Skipped) \n]
    }

    if {$::tcltest::numTests(Total) > 0} then {
      tputs $test_channel \
          [appendArgs "TOTAL: " $::tcltest::numTests(Total) \n]

      if {$::tcltest::numTests(Skipped) > 0} then {
        set percent [getSkipPercentage]
        tputs $test_channel [appendArgs "SKIP PERCENTAGE: " \
            [format "%.4f" $percent] %\n]
      }

      set percent [getPassPercentage]
      tputs $test_channel [appendArgs "PASS PERCENTAGE: " \
          [format "%.4f" $percent] %\n]
    } else {
      #
      # NOTE: No tests.
      #
      set percent 0
    }

    #
    # NOTE: Has the test pass threshold been set?  If so, is it set to
    #       the default value?
    #
    if {![info exists test_threshold] || $test_threshold == 100} then {
      #
      # NOTE: The test pass threshold is set to the default value (100%).
      #       Check to make sure that all tests pass and then set the
      #       exit code to success; otherwise, we set it to failure.
      #
      set passedOrSkipped [expr {$::tcltest::numTests(Passed) + \
          $::tcltest::numTests(Skipped)}]

      if {$passedOrSkipped == $::tcltest::numTests(Total)} then {
        set exitCode 0; # Success.

        tputs $test_channel "OVERALL RESULT: SUCCESS\n"
      } else {
        set exitCode 1; # Failure.

        tputs $test_channel "OVERALL RESULT: FAILURE\n"
      }

      unset passedOrSkipped
    } else {
      #
      # NOTE: They specified a non-default test pass threshold.  Check to
      #       make sure that we meet or exceed the requirement and then
      #       set the exit code to success; otherwise, set it to failure.
      #
      if {$percent >= $test_threshold} then {
        set exitCode 0; # Success.

        tputs $test_channel [appendArgs "OVERALL RESULT: SUCCESS (" \
            $percent "% >= " $test_threshold %)\n]
      } else {
        set exitCode 1; # Failure.

        tputs $test_channel [appendArgs "OVERALL RESULT: FAILURE (" \
            $percent "% < " $test_threshold %)\n]
      }
    }

    unset percent

    tputs $test_channel \n; # NOTE: Blank line.
  }

  #
  # NOTE: Check for and process any custom test epilogue script that may
  #       be set in the environment.
  #
  sourceIfValid epilogue [getEnvironmentVariable testEpilogue]

  #
  # NOTE: Do we need to exit now?
  #
  if {[isExitOnComplete]} then {
    #
    # NOTE: Exit now.  In Eagle, this will not exit the entire process.
    #       Zero (0) will be the exit code if all the selected tests have
    #       succeeded or the test success threshold has been met or
    #       exceeded; otherwise, one (1) will be the exit code.
    #
    exit $exitCode
  } else {
    #
    # NOTE: For Eagle, even when not exiting, we still set the ExitCode
    #       property of the interpreter.
    #
    if {[isEagle]} then {
      object invoke -alias Interpreter.GetActive ExitCode $exitCode
    }

    unset exitCode
  }
}

###############################################################################
#
# pkgIndex.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Package Index File
#
# Copyright (c) 2007-2010 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: $
#
###############################################################################

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
if {![package vsatisfies [package provide Eagle] 1.0]} {return}

package ifneeded EagleTestConstraints 1.0 [list source [file join $dir \
    constraints.eagle]]

###############################################################################
#
# pkgIndex.tcl --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Package Index File
#
# Copyright (c) 2007-2010 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: $
#
###############################################################################

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
if {[string length [package provide Eagle]] > 0} then {return}

package ifneeded EagleTestConstraints 1.0 [list source [file join $dir \
    constraints.eagle]]

###############################################################################
#
# prologue.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Test Prologue File
#
# Copyright (c) 2007-2010 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: $
#
###############################################################################

if {![info exists no([file tail [info script]])]} then {
  if {[info level] > 0} then {
    error "cannot run, current level is not global"
  }

  #
  # NOTE: Set the location of the test suite, if necessary.
  #
  if {![info exists test_path]} then {
    set test_path [file normalize [file dirname [info script]]]
  }

  #
  # NOTE: Set the location of the base Eagle directory, if
  #       necessary.
  #
  if {![info exists base_path]} then {
    #
    # NOTE: Start out going up one level and check for a "lib"
    #       sub-directory.  If not found, go up another level
    #       because we will always be two levels down from the
    #       base directory when running inside the source tree.
    #
    set base_path [file normalize [file dirname $test_path]]

    #
    # HACK: We must verify that the "init.eagle" file can eventually
    #       be found under the "lib" directory since Visual Studio
    #       insists on creating a superfluous (and empty) "lib\Eagle1.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.
    #
    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 {
      #
      # 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]
    }
  }

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

  #
  # NOTE: Set the location of the directory containing the
  #       executable file for the process, if necessary.
  #
  if {![info exists bin_path]} then {
    set bin_path [file normalize [file dirname $bin_file]]
  }

  #
  # NOTE: Set the location of the [non-script] library directory
  #       (i.e. the directory where the plugins are located), if
  #       necessary.
  #
  if {![info exists lib_path]} then {
    #
    # NOTE: This should go one directory up from the directory
    #       containing the executable file for the process (e.g.
    #       the shell) and then into the "lib" directory just
    #       beneath that.
    #
    set lib_path [file normalize [file join [file dirname $bin_path] lib]]
  }

  #
  # NOTE: Set the web host to test against, if necessary.
  #
  if {![info exists test_host]} then {
    set test_host eagle.to
  }

  #
  # NOTE: Set the port to use for server sockets, if necessary.
  #
  if {![info exists test_port]} then {
    set test_port 12346; # IANA, 12346-12752 Unassigned
  }

  #
  # NOTE: Set the network timeout, if necessary.
  #
  if {![info exists test_timeout]} then {
    set test_timeout 2000; # in milliseconds.
  }

  #
  # NOTE: Set the channel to use for test output, if necessary.
  #
  if {![info exists test_channel]} then {
    set test_channel stdout
  }

  #
  # NOTE: Set the primary package path, if necessary.
  #
  if {![info exists test_package_path]} then {
    set test_package_path [file join $base_path lib]
  }

  #
  # NOTE: Make sure our primary package path is part of the auto path.
  #
  if {[lsearch -exact $auto_path $test_package_path] == -1} then {
    lappend auto_path $test_package_path
  }

  #
  # NOTE: Make sure our test package path is part of the auto path.
  #
  if {[lsearch -exact $auto_path $test_path] == -1} then {
    lappend auto_path $test_path
  }

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

  #
  # NOTE: Check for and load the Eagle library package, if necessary.
  #
  if {[catch {package present EagleLibrary}]} then {
    package require EagleLibrary
  }

  #
  # NOTE: Check for and load the Eagle test package, if necessary.
  #
  if {[catch {package present EagleTest}]} then {
    package require EagleTest
  }

  #
  # NOTE: Check for and load the Eagle test constraints package, if
  #       necessary.
  #
  if {[catch {package present EagleTestConstraints}]} then {
    package require EagleTestConstraints
  }

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

  #
  # NOTE: If command line arguments were supplied, process them now.
  #
  set test_flags(-configuration) ""; # build configuration, default to empty.
  set test_flags(-suffix) ""; # build suffix, default to empty.
  set test_flags(-file) [list *.eagle]; # default to running all test files.
  set test_flags(-notFile) [list l.*.eagle]; # COMPAT: Tcl.
  set test_flags(-match) [list *]; # default to running all tests.
  set test_flags(-skip) [list]; # default to skipping no tests.
  set test_flags(-constraints) [list]; # default to no manual constraints.
  set test_flags(-logFile) ""; # default to using standard log file naming.
  set test_flags(-threshold) ""; # default to requiring all tests to pass.
  set test_flags(-stopOnFailure) ""; # default to continue on failure.
  set test_flags(-exitOnComplete) ""; # default to not exit after complete.

  #
  # NOTE: Check for and process any command line arguments.
  #
  if {[info exists argv]} then {
    eval processTestArguments test_flags $argv

    if {[info exists test_flags(-logFile)] && \
        [string length $test_flags(-logFile)] > 0} then {
      #
      # NOTE: Set the log file name to the one provided by the command line.
      #
      set test_log $test_flags(-logFile)
    }

    if {[info exists test_flags(-threshold)] && \
        [string is integer -strict $test_flags(-threshold)]} then {
      #
      # NOTE: Set the test pass threshold to the one provided by the command
      #       line.
      #
      set test_threshold $test_flags(-threshold)
    }

    if {[info exists test_flags(-stopOnFailure)] && \
        [string is boolean -strict $test_flags(-stopOnFailure)]} then {
      #
      # NOTE: Set the test stop-on-failure flag to the one provided by the
      #       command line.
      #
      set test_stop_on_failure $test_flags(-stopOnFailure)
    }

    if {[info exists test_flags(-exitOnComplete)] && \
        [string is boolean -strict $test_flags(-exitOnComplete)]} then {
      #
      # NOTE: Set the test exit-on-complete flag to the one provided by the
      #       command line.
      #
      set test_exit_on_complete $test_flags(-exitOnComplete)
    }
  }

  #
  # NOTE: Set the default test configuration (i.e. Debug or Release), if
  #       necessary.
  #
  if {![info exists test_configuration]} then {
    set test_configuration [getPlatformInfo configuration Release]
  }

  #
  # NOTE: Set the Tcl shell executable to use for those specialized
  #       tests that may require it, if necessary.
  #
  if {![info exists test_tclsh]} then {
    if {[isEagle] || ![string match tclsh* $bin_file]} then {
      set test_tclsh tclsh
    } else {
      set test_tclsh $bin_file
    }
  }

  #
  # NOTE: Has logging been disabled?
  #
  if {![info exists no(log)]} then {
    #
    # NOTE: Set the log to use for test output, if necessary.
    #
    if {![info exists test_log]} then {
      set test_log [file join [getTemporaryPath] [file tail [info \
          nameofexecutable]][getTestLogId].test.[pid].log]
    }
  }

  #
  # NOTE: Check for and process any custom test prologue script that may be set
  #       in the environment.  This must be done after the Eagle test package
  #       has been made available and after the log file has been setup.
  #
  sourceIfValid prologue [getEnvironmentVariable testPrologue]

  #
  # NOTE: Show the name of the executable and the command line arguments, if
  #       any.  This must be done after the log file has been setup; otherwise,
  #       this information will not be visible in the log file.
  #
  tputs $test_channel [appendArgs "---- testRunId: " \
      [getTestRunId] \n]

  tputs $test_channel [appendArgs "---- processId: " \
      [pid] \n]

  tputs $test_channel [appendArgs "---- test channel: " \
      $test_channel \n]

  tputs $test_channel [appendArgs "---- test configuration: " \
      $test_configuration \n]

  if {[isEagle]} then {
    tputs $test_channel [appendArgs "---- original command line: " \
        [info cmdline] \n]

    tputs $test_channel [appendArgs "---- threadId: " \
        [info tid] \n]

    tputs $test_channel [appendArgs "---- processors: " \
        [info processors] \n]

    tputs $test_channel [appendArgs "---- starting memory: " \
        [formatListAsDict [debug memory]] \n]

    catch {debug stack true} stack

    tputs $test_channel [appendArgs "---- starting stack: " \
        [formatListAsDict $stack] \n]

    unset stack
    catch {file drive} drive

    tputs $test_channel [appendArgs "---- system drive: " \
        [formatListAsDict $drive] \n]

    unset drive
  }

  tputs $test_channel [appendArgs "---- executable: \"" \
      $bin_file \"\n]

  tputs $test_channel [appendArgs "---- command line: " \
      [expr {[info exists argv] && [string length $argv] > 0 ? \
          $argv : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- logging to: " \
      [expr {[info exists test_log] && [string length $test_log] > 0 ? \
          [appendArgs \" $test_log \"] : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- pass threshold: " \
      [expr {[info exists test_threshold] && \
          [string is integer -strict $test_threshold] ? \
              [appendArgs $test_threshold %] : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- stop on failure: " \
      [expr {[info exists test_stop_on_failure] && \
          [string is boolean -strict $test_stop_on_failure] ? \
              $test_stop_on_failure : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- exit on complete: " \
      [expr {[info exists test_exit_on_complete] && \
          [string is boolean -strict $test_exit_on_complete] ? \
              $test_exit_on_complete : "<none>"}] \n]

  #
  # NOTE: Show the information about which tests and files are being run and/or
  #       skipped (COMPAT: Tcl).
  #
  if {[llength $test_flags(-file)] > 0} then {
    tputs $test_channel [appendArgs "---- running test files that match: " \
        $test_flags(-file) \n]
  }

  if {[llength $test_flags(-notFile)] > 0} then {
    tputs $test_channel [appendArgs "---- skipping test files that match: " \
        $test_flags(-notFile) \n]
  }

  if {[llength $test_flags(-match)] > 0} then {
    tputs $test_channel [appendArgs "---- running tests that match: " \
        $test_flags(-match) \n]
  }

  if {[llength $test_flags(-skip)] > 0} then {
    tputs $test_channel [appendArgs "---- skipping tests that match: " \
        $test_flags(-skip) \n]
  }

  tputs $test_channel [appendArgs "---- path: \"" \
      [expr {[info exists path] && [string length $path] > 0 ? \
          $path : "<none>"}] \"\n]

  tputs $test_channel [appendArgs "---- base path: \"" \
      $base_path \"\n]

  tputs $test_channel [appendArgs "---- binary path: \"" \
      $bin_path \"\n]

  tputs $test_channel [appendArgs "---- library path: \"" \
      $lib_path \"\n]

  tputs $test_channel [appendArgs "---- tests located in: \"" \
      $test_path \"\n]

  tputs $test_channel [appendArgs "---- tests running in: \"" \
      [pwd] \"\n]

  tputs $test_channel [appendArgs "---- temporary files stored in: \"" \
      [getTemporaryPath] \"\n]

  tputs $test_channel [appendArgs "---- native Tcl shell: \"" \
      $test_tclsh \"\n]

  #
  # NOTE: Initialize the Eagle test constraints.
  #
  if {[isEagle]} then {
    initializeTests

    #
    # NOTE: If the "no(mono)" variable is set (to anything) then any
    #       special test suite hacks for Mono will be disabled. This
    #       does not control or change any hacks for Mono that may
    #       be present in the library itself.
    #
    # if {![info exists no(mono)] && [isMono]} then {
    #   set no(mono) true
    # }

    #
    # NOTE: Has administrator detection support been disabled?  We do
    #       this check [nearly] first as it may [eventually] be used
    #       to help determine if other constraints should be skipped.
    #
    if {![info exists no(administrator)]} then {
      checkForAdministrator $test_channel
    }

    #
    # NOTE: Has host detection support been disabled?
    #
    if {![info exists no(host)]} then {
      checkForHost $test_channel
    }

    #
    # NOTE: Has primary thread detection support been disabled?  We do
    #       this check [nearly] first as it may [eventually] be used
    #       to help determine if other constraints should be skipped.
    #
    if {![info exists no(primaryThread)]} then {
      checkForPrimaryThread $test_channel
    }

    #
    # NOTE: Has runtime detection support been disabled?  We do this
    #       checking [nearly] first as it may skip other constraints.
    #
    if {![info exists no(runtime)]} then {
      checkForRuntime $test_channel
    }

    #
    # NOTE: Check the runtime version (i.e. what version of the runtime
    #       are we currently running on?).
    #
    if {![info exists no(runtimeVersion)]} then {
      checkForRuntimeVersion $test_channel
    }

    #
    # NOTE: Check the image runtime version (i.e. what version of the
    #       runtime was this assembly compiled against?).
    #
    if {![info exists no(imageRuntimeVersion)]} then {
      checkForImageRuntimeVersion $test_channel
    }

    #
    # NOTE: Has machine detection support been disabled?
    #
    if {![info exists no(machine)]} then {
      checkForMachine $test_channel 32 intel; # (i.e. x86)
      checkForMachine $test_channel 64 amd64; # (i.e. x64)
    }

    #
    # NOTE: Has culture detection support been disabled?
    #
    if {![info exists no(culture)]} then {
      checkForCulture $test_channel
    }

    #
    # NOTE: Has software update trust detection support been disabled?
    #
    if {![info exists no(softwareUpdate)]} then {
      checkForSoftwareUpdateTrust $test_channel
    }

    #
    # NOTE: Has database testing support been disabled?
    #
    if {![info exists no(sql)]} then {
      #
      # NOTE: Set the server name, if necessary.
      #
      if {![info exists server]} then {
        set server .
      }

      #
      # NOTE: Set the database name, if necessary.
      #
      if {![info exists database]} then {
        set database master
      }

      #
      # NOTE: Set the connection timeout, if necessary.
      #
      if {![info exists timeout]} then {
        set timeout [expr {$test_timeout / 1000}]; # milliseconds to seconds.
      }

      #
      # NOTE: Set the test user name, if necessary.
      #
      if {![info exists user]} then {
        set user [getEnvironmentVariable user]
      }

      #
      # NOTE: Set the test password, if necessary.
      #
      if {![info exists password]} then {
        set password [getEnvironmentVariable password]
      }

      #
      # NOTE: Set the database connection string, if necessary.
      #
      if {![info exists test_database]} then {
        #
        # NOTE: Mono does not have support for trusted connections;
        #       therefore, we must create a slightly different
        #       connection string.
        #
        set test_database [subst \
            {Data Source=${server};Initial Catalog=${database};Connect\
            Timeout=${timeout};[expr {[isMono] ? [subst \
            {User Id=${user};Password=${password};}] : {Integrated\
            Security=SSPI;}}]}]
      }

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

    #
    # NOTE: Has object handle reference count tracking support been disabled
    #       (at compile-time)?
    #
    if {![info exists no(refCount)]} then {
      #
      # NOTE: For tests "excel-*", "object-2.*", "object-7.1", "object-8.*",
      #       and "object-98.*".
      #
      checkForReferenceCountTracking $test_channel
    }

    #
    # NOTE: Has compile/runtime option testing support been disabled?
    #
    if {![info exists no(compileOptions)]} then {
      #
      # NOTE: Has callback queue support been enabled (at compile-time)?
      #
      if {![info exists no(compileCallbackQueue)]} then {
        #
        # NOTE: For test "commands-1.4".
        #
        checkForCompileOption $test_channel CALLBACK_QUEUE
      }

      #
      # NOTE: Has console support been enabled (at compile-time)?
      #
      if {![info exists no(compileConsole)]} then {
        #
        # NOTE: For test "host-1.2".
        #
        checkForCompileOption $test_channel CONSOLE
      }

      #
      # NOTE: Has database support been enabled (at compile-time)?
      #
      if {![info exists no(compileData)]} then {
        #
        # NOTE: For tests "sql-1.1" and "upvar-99.1".
        #
        checkForCompileOption $test_channel DATA
      }

      #
      # NOTE: Has script debugger support been enabled (at compile-time)?
      #
      if {![info exists no(compileDebugger)]} then {
        #
        # NOTE: For tests "debug-1.1", "debug-2.1", "debug-3.1" and
        #       "debug-4.1".
        #
        checkForCompileOption $test_channel DEBUGGER
      }

      #
      # NOTE: Has isolated interpreter support been enabled (at compile-time)?
      #
      if {![info exists no(compileIsolatedInterpreters)]} then {
        #
        # NOTE: For test "xaml-1.2".
        #
        checkForCompileOption $test_channel ISOLATED_INTERPRETERS
      }

      #
      # NOTE: Has isolated plugin support been enabled (at compile-time)?
      #
      if {![info exists no(compileIsolatedPlugins)]} then {
        #
        # NOTE: For test "load-1.1.1".
        #
        checkForCompileOption $test_channel ISOLATED_PLUGINS
      }

      #
      # NOTE: Has PowerShell approved-verbs support been enabled (at
      #       compile-time)?
      #
      if {![info exists no(compileApprovedVerbs)]} then {
        #
        # NOTE: For test "object-4.8".
        #
        checkForCompileOption $test_channel APPROVED_VERBS
      }

      #
      # NOTE: Has Mono support been enabled (at compile-time)?
      #
      if {![info exists no(compileMono)]} then {
        #
        # NOTE: For test "object-4.13".
        #
        checkForCompileOption $test_channel MONO
      }

      #
      # NOTE: Has Windows support been enabled (at compile-time)?
      #
      if {![info exists no(compileWindows)]} then {
        #
        # NOTE: For test "garuda-1.0".
        #
        checkForCompileOption $test_channel WINDOWS
      }

      #
      # NOTE: Has native code support been enabled (at compile-time)?
      #
      if {![info exists no(compileNative)]} then {
        #
        # NOTE: For tests "debug-3.2", "expr-3.2", and "host-1.1".
        #
        checkForCompileOption $test_channel NATIVE
      }

      #
      # NOTE: Has native package support been enabled (at compile-time)?
      #
      if {![info exists no(compileNativePackage)]} then {
        #
        # NOTE: For test "garuda-1.0".
        #
        checkForCompileOption $test_channel NATIVE_PACKAGE
      }

      #
      # NOTE: Has network support been enabled (at compile-time)?
      #
      if {![info exists no(compileNetwork)]} then {
        #
        # NOTE: For tests "commands-1.4", "socket-1.*", "socket-2.1", and
        #       "socket-3.1".
        #
        checkForCompileOption $test_channel NETWORK
      }

      #
      # NOTE: Has native Tcl support been enabled (at compile-time)?
      #
      if {![info exists no(compileTcl)]} then {
        #
        # NOTE: For tests "commands-1.1.*", "excel-2.2", "tclCancel-1.1",
        #       "tclEncoding-1.*", "tclErrorInfo-1.*", "tclLoad-1.*",
        #       "tclResetCancel-1.1", "tclResetCancel-2.1",
        #       "tclResetCancel-2.2", "tclResetCancel-3.1",
        #       "tclResetCancel-4.1", "tclSet-1.1", and "tclSubst-1.1".
        #
        checkForCompileOption $test_channel TCL
      }

      #
      # NOTE: Has xml support been enabled (at compile-time)?
      #
      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 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",
        #       "object-2.1", "object-3.1", "object-4.1", "object-7.1",
        #       "object-7.2", "object-7.4", "object-14.4", "object-14.5",
        #       "object-14.6", "remotingServer-1.*", and "debug-5.*".
        #
        checkForCompileOption $test_channel TEST
      }

      #
      # NOTE: Has threading support been enabled (at compile-time)?
      #
      if {![info exists no(compileThreading)]} then {
        #
        # NOTE: For tests "object-10.2" and "object-10.3".
        #
        checkForCompileOption $test_channel THREADING
      }

      #
      # NOTE: Has Tcl threading support been enabled (at compile-time)?
      #
      if {![info exists no(compileTclThreaded)]} then {
        #
        # NOTE: For tests "tclLoad-1.5" and "tclLoad-1.6".
        #
        checkForCompileOption $test_channel TCL_THREADED
      }

      #
      # NOTE: Has Tcl isolated interpreter thread support been enabled (at
      #       compile-time)?
      #
      if {![info exists no(compileTclThreads)]} then {
        #
        # NOTE: For tests "tclLoad-1.5" and "tclLoad-1.6".
        #
        checkForCompileOption $test_channel TCL_THREADS
      }
    }

    #
    # NOTE: Has dynamic loading testing support been disabled?
    #
    if {![info exists no(dynamic)]} then {
      #
      # NOTE: For tests "commands-1.1.*", "library-3.*", and "tcl*-*.*".
      #
      checkForDynamicLoading $test_channel
    }

    #
    # NOTE: Has Tcl testing support been disabled?
    #
    if {![info exists no(tcl)]} then {
      if {![info exists no(tclInstalls)]} then {
        #
        # NOTE: For tests "commands-1.1.*", "library-3.*", and "tcl*-*.*".
        #
        checkForTclInstalls $test_channel
      }

      if {![info exists no(tclReady)]} then {
        checkForTclReady $test_channel
      }

      if {![info exists no(tclShell)]} then {
        #
        # NOTE: For test "garuda-1.0".
        #
        checkForTclShell $test_channel
      }
    }

    #
    # NOTE: Has custom test method support been disabled?
    #
    if {![info exists no(test)]} then {
      #
      # NOTE: Has remoting testing support been disabled?
      #
      if {![info exists no(testRemoting)]} then {
        #
        # NOTE: For tests "remotingServer-1.*".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestRemoting*
      }

      #
      # NOTE: Has asynchronous testing support been disabled?
      #
      if {![info exists no(testAsynchronous)]} then {
        #
        # NOTE: For tests "basic-1.20" and "basic-1.21".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestEvaluateAsync*
      }

      #
      # NOTE: Has custom function testing support been disabled?
      #
      if {![info exists no(testFunction)]} then {
        #
        # NOTE: For test "function-1.1".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestAddFunction*

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

      #
      # NOTE: Has write-box testing support been disabled?
      #
      if {![info exists no(testWriteBox)]} then {
        #
        # NOTE: For tests "debug-5.*".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestWriteBox*
      }

      #
      # NOTE: Has core marshaller testing support been disabled?
      #
      if {![info exists no(testMarshaller)]} then {
        #
        # NOTE: For test "object-2.1".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestComplexMethod*

        #
        # NOTE: For test "object-2.3".
        #
        checkForObjectMember $test_channel Eagle._Components.Private.ArrayOps \
            *ToHexadecimalString*

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

        #
        # NOTE: For tests "object-14.4" and "object-14.5".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *StaticObjectProperty*

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

        #
        # NOTE: For test "basic-1.29".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestExecuteStaticDelegates*

        #
        # NOTE: For tests "basic-1.30" and "basic-1.31".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestExecuteDelegateCommands*

        #
        # NOTE: For test "object-7.2" and "object-7.4".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestNullArray*

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

    #
    # NOTE: Has Excel testing support been disabled?
    #
    if {![info exists no(excel)]} then {
      #
      # NOTE: For tests "excel-*.*".
      #
      checkForAssembly $test_channel Microsoft.Office.Interop.Excel
    }

    #
    # NOTE: Has speech testing support been disabled?
    #
    if {![info exists no(speech)]} then {
      #
      # NOTE: Set the audio volume, if necessary.
      #
      if {![info exists test_volume]} then {
        set test_volume 0; # in percent, 0 is silent.
      }

      #
      # NOTE: For test "object-4.5".
      #
      checkForAssembly $test_channel System.Speech
    }

    #
    # NOTE: Has WinForms testing support been disabled?
    #
    if {![info exists no(winForms)]} then {
      #
      # NOTE: For tests "object-13.1.*", "object-13.2.*", and
      #       "winForms-*.*".
      #
      checkForWindowsForms $test_channel
    }

    #
    # NOTE: Are we running in an STA thread?
    #
    if {![info exists no(staThread)]} then {
      #
      # NOTE: For test "xaml-1.*".
      #
      checkForStaThread $test_channel
    }

    #
    # NOTE: Has WPF testing support been disabled?
    #
    if {![info exists no(wpf)]} then {
      #
      # NOTE: For test "xaml-1.*".
      #
      checkForWindowsPresentationFoundation $test_channel
    }

    #
    # NOTE: Has PowerShell testing support been disabled?
    #
    if {![info exists no(powerShell)]} then {
      #
      # NOTE: For tests "object-4.7", "object-4.8", and "object-4.9".
      #
      checkForPowerShell $test_channel
    }

    #
    # NOTE: Has WiX testing support been disabled?
    #
    if {![info exists no(wix)]} then {
      #
      # NOTE: For test "object-4.10".
      #
      checkForWix $test_channel
    }

    #
    # NOTE: Has managed debugger testing support been disabled?
    #
    if {![info exists no(managedDebugger)]} then {
      checkForManagedDebugger $test_channel
    }

    #
    # NOTE: Has script debugger testing support been disabled?
    #
    if {![info exists no(scriptDebugger)]} then {
      #
      # NOTE: For tests "debug-1.1", "debug-2.1", "debug-3.1", and
      #       "debug-4.1".
      #
      checkForScriptDebugger $test_channel
    }

    #
    # NOTE: Has script debugger interpreter testing support been
    #       disabled?
    #
    if {![info exists no(scriptDebuggerInterpreter)]} then {
      #
      # NOTE: For test "debug-2.1".
      #
      checkForScriptDebuggerInterpreter $test_channel
    }

    #
    # NOTE: Are we running under the Mono debugger?  If so, several
    #       tests will have to be disabled because they do not appear
    #       to work there.
    #
    if {![info exists no(monoDebugger)]} then {
      tputs $test_channel "---- checking for Mono debugger... "

      if {[haveConstraint mono] && [haveConstraint managedDebugger]} then {
        #
        # NOTE: Add a special test constraint to simplify the Mono debugger
        #       test constraint checking for the tests that need it.
        #
        addConstraint monoDebugger

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

    #
    # NOTE: Has Garuda testing support been disabled?
    #
    if {![info exists no(garudaDll)]} then {
      #
      # NOTE: For test "garuda-1.0".
      #
      checkForGarudaDll $test_channel
    }
  } else {
    #
    # HACK: Reset the test counts for tcltest.
    #
    set ::tcltest::numTests(Total) 0
    set ::tcltest::numTests(Skipped) 0
    set ::tcltest::numTests(Passed) 0
    set ::tcltest::numTests(Failed) 0

    #
    # HACK: Reset the list of failed files.
    #
    set ::tcltest::failFiles [list]
  }

  #
  # NOTE: For test "package-1.0".
  #
  if {![info exists no(pkgAll.tcl)]} then {
    checkForFile $test_channel [file join $base_path Package Tests all.tcl] \
        pkgAll.tcl
  }

  #
  # NOTE: For test "subst-1.*".
  #
  if {![info exists no(bad_subst.txt)]} then {
    checkForFile $test_channel [file join $test_path bad_subst.txt]
  }

  #
  # NOTE: For test "fileIO-1.*".
  #
  if {![info exists no(file.dat)]} then {
    checkForFile $test_channel [file join $test_path file.dat]
  }

  #
  # NOTE: For test "garbage-1.1".
  #
  if {![info exists no(garbage.txt)]} then {
    checkForFile $test_channel [file join $test_path garbage.txt]
  }

  #
  # NOTE: For test "xaml-1.*".
  #
  if {![info exists no(test.png)]} then {
    checkForFile $test_channel [file join $test_path test.png]
  }

  #
  # NOTE: For test "socket-1.2".
  #
  if {![info exists no(client.tcl)]} then {
    checkForFile $test_channel [file join $test_path client.tcl]
  }

  #
  # NOTE: For test "tclLoad-1.2".
  #
  if {![info exists no(tcl_unload.tcl)]} then {
    checkForFile $test_channel [file join $test_path tcl_unload.tcl]
  }

  #
  # NOTE: For test "read.eagle".
  #
  if {![info exists no(read.eagle)]} then {
    checkForFile $test_channel [file join $test_path read.eagle]
  }

  #
  # NOTE: For test "read2.eagle".
  #
  if {![info exists no(read2.eagle)]} then {
    checkForFile $test_channel [file join $test_path read2.eagle]
  }

  #
  # NOTE: For test "read3.eagle".
  #
  if {![info exists no(read3.eagle)]} then {
    checkForFile $test_channel [file join $test_path read3.eagle]
  }

  #
  # NOTE: For test "read4.eagle".
  #
  if {![info exists no(read4.eagle)]} then {
    checkForFile $test_channel [file join $test_path read4.eagle]
  }

  #
  # NOTE: For test "source.eagle".
  #
  if {![info exists no(source.eagle)]} then {
    checkForFile $test_channel [file join $test_path source.eagle]
  }

  #
  # NOTE: For test "unbalanced_brace.eagle".
  #
  if {![info exists no(unbalanced_brace.eagle)]} then {
    checkForFile $test_channel [file join $test_path unbalanced_brace.eagle]
  }

  #
  # NOTE: For test "unbalanced_brace2.eagle".
  #
  if {![info exists no(unbalanced_brace2.eagle)]} then {
    checkForFile $test_channel [file join $test_path unbalanced_brace2.eagle]
  }

  #
  # NOTE: For test "excel-2.*".
  #
  if {![info exists no(test.xls)]} then {
    checkForFile $test_channel [file join $test_path test.xls]
  }

  #
  # NOTE: For test "load-1.1.*".
  #
  if {![info exists no(Plugin.dll)]} then {
    checkForFile $test_channel [file join $lib_path Plugin1.0 Plugin.dll]
  }

  #
  # NOTE: For test "object-6.1".
  #
  if {![info exists no(Sample.exe)]} then {
    checkForFile $test_channel [file join $bin_path Sample.exe]
  }

  #
  # NOTE: For test "object-4.8".
  #
  if {![info exists no(EagleCmdlets.dll)]} then {
    checkForFile $test_channel [file join $bin_path EagleCmdlets.dll]
  }

  #
  # NOTE: For test "object-4.10".
  #
  if {![info exists no(EagleExtensions.dll)]} then {
    checkForFile $test_channel [file join $bin_path EagleExtensions.dll]
  }

  #
  # NOTE: For test "object-4.10".
  #
  if {![info exists no(test.wxs)]} then {
    checkForFile $test_channel [file join $base_path Installer Tests test.wxs]
  }

  #
  # NOTE: For test "sql-1.2".
  #
  if {![info exists no(sqlite3.dll)]} then {
    checkForFile $test_channel [file join $bin_path sqlite3.dll]
  }

  if {![info exists no(System.Data.SQLite.dll)]} then {
    checkForFile $test_channel [file join $bin_path System.Data.SQLite.dll]
  }

  if {![info exists no(test.sqlite3)]} then {
    checkForFile $test_channel [file join $test_path test.sqlite3]
  }

  #
  # NOTE: Check the core test constraints unless they have been
  #       explicitly disabled.
  #
  if {![info exists no(platform)]} then {
    checkForPlatform $test_channel
  }

  if {![info exists no(version)]} then {
    checkForVersion $test_channel
  }

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

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

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

  if {![info exists no(debug)]} then {
    checkForDebug $test_channel
  }

  #
  # NOTE: Has native code detection support been disabled?
  #
  if {![info exists no(native)]} then {
    checkForNativeCode $test_channel
  }

  #
  # NOTE: Check for various extra commands that may be present.
  #
  if {![info exists no(callbackCommand)]} then {
    checkForCommand $test_channel callback
  }

  if {![info exists no(libraryCommand)]} then {
    checkForCommand $test_channel library
  }

  if {![info exists no(socketCommand)]} then {
    checkForCommand $test_channel socket
  }

  if {![info exists no(sqlCommand)]} then {
    checkForCommand $test_channel sql
  }

  if {![info exists no(tclCommand)]} then {
    checkForCommand $test_channel tcl
  }

  if {![info exists no(xmlCommand)]} then {
    checkForCommand $test_channel xml
  }

  #
  # NOTE: Check for various features that were added through
  #       the TIP process.
  #
  if {![info exists no(tip127)]} then {
    checkForTip127 $test_channel
  }

  if {![info exists no(tip194)]} then {
    checkForTip194 $test_channel
  }

  if {![info exists no(tip241)]} then {
    checkForTip241 $test_channel
  }

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

  #
  # NOTE: Has performance testing been disabled?
  #
  if {![info exists no(performance)]} then {
    checkForPerformance $test_channel
  }

  #
  # NOTE: Have precision timing tests been disabled?
  #
  if {![info exists no(timing)]} then {
    checkForTiming $test_channel 50; # 1/20th second.
  }

  #
  # NOTE: Has interactive testing been disabled?
  #
  if {![info exists no(interactive)]} then {
    checkForInteractive $test_channel
  }

  if {![info exists no(userInteraction)]} then {
    checkForUserInteraction $test_channel
  }

  #
  # NOTE: Check for network connectivity to our test host (i.e.
  #       the Eagle distribution site).
  #
  if {![info exists no(network)]} then {
    checkForNetwork $test_channel $test_host $test_timeout
  }

  #
  # NOTE: For Eagle, dump the platform information, including
  #       the compile options.
  #
  if {[isEagle]} then {
    #
    # NOTE: Figure out the approximate relative performance
    #       of this machine.
    #
    if {[haveConstraint performance]} then {
      tputs $test_channel [appendArgs \
          "---- checking for baseline BogoCops (commands-per-second)... "]

      if {![info exists test_base_cops]} then {
        #
        # NOTE: The expected performance numbers for all the
        #       performance tests will be calibrated based on
        #       this number (which is based on the measured
        #       performance of the actual machine that was
        #       used to determine those expected performance
        #       numbers).
        #
        set test_base_cops 36000.0
      }

      tputs $test_channel [appendArgs $test_base_cops \n]
      tputs $test_channel [appendArgs \
          "---- checking for current BogoCops (commands-per-second)... "]

      if {![info exists test_cops]} then {
        set test_cops [calculateBogoCops]
      }

      tputs $test_channel [appendArgs $test_cops \n]
    }

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

    set timeStamp [getPlatformInfo timeStamp ""]

    if {[string length $timeStamp] > 0} then {
      #########################################################################
      # MONO: Bug, see: https://bugzilla.novell.com/show_bug.cgi?id=479061
      #########################################################################

      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]
      }
    } else {
      set timeStamp <none>
    }

    tputs $test_channel [appendArgs "---- build: " \
        [getPlatformInfo engine <none>] " " \
        [getPlatformInfo patchLevel <none>] " " \
        [getPlatformInfo tag <none>] " " \
        [getPlatformInfo text <none>] " " \
        [getPlatformInfo configuration <none>] " " \
        [getPlatformInfo suffix <none>] " " \
        $timeStamp \n]

    tputs $test_channel [appendArgs "---- os: " \
        [getPlatformInfo os <none>] \n]

    tputs $test_channel [appendArgs "---- globalAssemblyCache: " \
        [getPlatformInfo globalAssemblyCache <none>] \n]

    tputs $test_channel [appendArgs "---- moduleVersionId: " \
        [getPlatformInfo moduleVersionId <none>] \n]

    tputs $test_channel [appendArgs "---- compileOptions: " \
        [formatList [getPlatformInfo compileOptions <none>]] \n]

    tputs $test_channel [appendArgs "---- strongName: " \
        [getPlatformInfo strongName <none>] \n]

    tputs $test_channel [appendArgs "---- certificate: " \
        [getPlatformInfo certificate <none>] \n]

    unset timeStamp
  }

  #
  # NOTE: Show the current test file name, if any.
  #
  tputs $test_channel [appendArgs "---- test file: " \
      [expr {[info exists test_file] && [string length $test_file] > 0 ? \
      $test_file : "<none>"}] \n]

  #
  # NOTE: Show the active test constraints.
  #
  tputs $test_channel [appendArgs "---- constraints: " \
      [formatList [lsort [getConstraints]]] \n]

  #
  # NOTE: Show when the tests actually began (now).
  #
  tputs $test_channel [appendArgs "---- tests began at " \
      [clock format [clock seconds]] \n]
}

###############################################################################
#
# embed.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Application Embedding Initialization File
#
# Copyright (c) 2007-2010 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: $
#
###############################################################################

#
# STUB: This script file is a placeholder.  This file, when present, is always
#       evaluated when an interpreter is initialized.  Applications embedding
#       Eagle can place custom application-specific, interpreter-specific
#       initialization and/or customizations in here.  Additionally, this file
#       may contain per-interpreter customizations required when porting to
#       new platforms, operating systems, etc.
#
 

###############################################################################
#
# init.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Interpreter Initialization File
#
# Copyright (c) 2007-2010 by Joe Mistachkin.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: $
#
###############################################################################

#
# NOTE: Use our own namespace here because even though we do not directly
#       support namespaces ourselves, we do not want to pollute the global
#       namespace if this script actually ends up being evaluated in Tcl.
#
namespace eval ::Eagle {
  #
  # NOTE: This 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.
  #
  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.
    #       by the test suite).
    #
    return [expr {[info exists ::tcl_platform(engine)] && \
        [string compare -nocase eagle $::tcl_platform(engine)] == 0}]
  }
 
  proc haveGaruda { {varName ""} } {
    #
    # NOTE: Check for a variable name to place the Garuda package Id into.
    #
    if {[string length $varName] > 0} then {
      upvar 1 $varName packageId
    }

    #
    # NOTE: Is the Eagle Package for Tcl (Garuda) available?  This check
    #       is different in Eagle and Tcl.
    #
    if {[isEagle]} then {
      return [expr {[llength [info commands tcl]] > 0 && [tcl ready] && \
          [catch {tcl eval [tcl master] package present Garuda}] == 0 && \
          [catch {tcl eval [tcl master] garuda packageid} packageId] == 0}]
    } else {
      return [expr {[catch {package present Garuda}] == 0 && \
          [catch {garuda packageid} packageId] == 0}]
    }
  }
 
  #
  # NOTE: This is the procedure that detects whether or not we are
  #       running in Eagle on Mono (otherwise, we are running in Tcl
  #       or in Eagle on .NET).  This procedure must function correctly
  #       in both Tcl and Eagle and must return non-zero only when
  #       running in Eagle on Mono.
  #
  proc isMono {} {
    return [expr {[info exists ::eagle_platform(runtime)] && \
        [string compare -nocase mono $::eagle_platform(runtime)] == 0}]
  }
 
  proc getEnvironmentVariable { name } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    return [expr {[info exists ::env($name)] ? $::env($name) : ""}]
  }
 
  proc getCompileInfo {} {
    #
    # NOTE: Return the important compile-time information for use by the
    #       setup or other callers.
    #
    return [expr {[isEagle] ? [lappend result \
        TimeStamp $::eagle_platform(timeStamp) \
        ImageRuntimeVersion $::eagle_platform(imageRuntimeVersion) \
        ModuleVersionId $::eagle_platform(moduleVersionId) \
        CompileOptions $::eagle_platform(compileOptions)] : ""}]
  }
 
  proc getPlatformInfo { name {default ""} } {
    #
    # NOTE: Return the important platform information for use by the test
    #       suite or other callers.
    #
    return [expr {[isEagle] && [info exists ::eagle_platform($name)] && \
        [string length [string trim $::eagle_platform($name)]] > 0 ? \
        $::eagle_platform($name) : $default}]
  }
 
  proc getPluginPath { pattern } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    foreach loaded [info loaded] {
      if {[regexp -- $pattern [lindex $loaded end]]} then {
        return [lindex $loaded 0]
      }
    }

    return ""
  }
 
  proc appendArgs { args } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set result ""; eval append result $args
  }
 
  proc lappendArgs { args } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    eval lappend result $args
  }
 
  proc getDictionaryValue { dictionary name {default ""} {wrap ""} } {
    #
    # NOTE: Start with the default value.
    #
    set result $default

    #
    # NOTE: Locate the index of the named value we are interested in.
    #
    set index [lsearch -exact $dictionary $name]

    #
    # NOTE: Did we find the name in the row?
    #
    if {$index != -1} then {
      #
      # NOTE: The next element in the list will be the value.
      #
      incr index

      #
      # NOTE: Grab the value.
      #
      set result [appendArgs $wrap [lindex $dictionary $index] $wrap]
    }
  }
 
  proc getColumnValue { row column {default ""} {wrap ""} } {
    #
    # NOTE: Start with the default value.
    #
    set result $default

    #
    # NOTE: Locate the index of the named column we are interested in.
    #       This requires Tcl 8.5 or Eagle.
    #
    set index [lsearch -exact -index 0 $row $column]

    #
    # NOTE: Did we find the column name in the row?
    #
    if {$index != -1} then {
      #
      # NOTE: Grab the column value.
      #
      set result [appendArgs $wrap [lindex [lindex $row $index] end] $wrap]
    }

    return $result
  }
 
  proc getRowColumnValue { varName id column {default ""} {wrap ""} } {
    #
    # NOTE: Start with the default value.
    #
    set result $default

    #
    # NOTE: We need acccess to the result array (from the context of the
    #       caller).
    #
    upvar 1 $varName rows

    #
    # NOTE: Make sure we have the first result row.
    #
    if {[info exists rows($id)]} then {
      #
      # NOTE: Grab the entire row we are interested in.
      #
      set row $rows($id)

      #
      # NOTE: Grab the value at the specified column.
      #
      set result [getColumnValue $row $column $default $wrap]
    }

    return $result
  }
 
  proc readFile { fileName } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set file_id [open $fileName RDONLY]
    fconfigure $file_id -encoding binary -translation binary; # BINARY DATA
    set result [read $file_id]
    close $file_id
    return $result
  }
 
  proc writeFile { fileName data } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set file_id [open $fileName {WRONLY CREAT TRUNC}]
    fconfigure $file_id -encoding binary -translation binary; # BINARY DATA
    puts -nonewline $file_id $data
    close $file_id
    return ""
  }
 
  proc appendFile { fileName data } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set file_id [open $fileName {WRONLY CREAT APPEND}]
    fconfigure $file_id -encoding binary -translation binary; # BINARY DATA
    puts -nonewline $file_id $data
    close $file_id
    return ""
  }
 
  proc appendLogFile { fileName data } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set file_id [open $fileName {WRONLY CREAT APPEND}]
    fconfigure $file_id -encoding binary -translation \
        [expr {[isEagle] ? "protocol" : "auto"}]; # LOG DATA
    puts -nonewline $file_id $data
    close $file_id
    return ""
  }
 
  proc appendSharedFile { fileName data } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set command [list open $fileName {WRONLY CREAT APPEND}]

    #
    # HACK: Tcl appears to do this by default; however Eagle does not and
    #       will not.  Therefore, manually add the -share option to the
    #       command if running in Eagle.
    #
    if {[isEagle]} then {
      lappend command 0 file -share readWrite
    }

    #
    # NOTE: Open the file using the command constructed above, configure
    #       the channel for binary data, and output the data to it.
    #
    set file_id [eval $command]
    fconfigure $file_id -encoding binary -translation binary; # BINARY DATA
    puts -nonewline $file_id $data; flush $file_id
    close $file_id
    return ""
  }
 
  proc appendSharedLogFile { fileName data } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set command [list open $fileName {WRONLY CREAT APPEND}]

    #
    # HACK: Tcl appears to do this by default; however Eagle does not and
    #       will not.  Therefore, manually add the -share option to the
    #       command if running in Eagle.
    #
    if {[isEagle]} then {
      lappend command 0 file -share readWrite
    }

    #
    # NOTE: Open the file using the command constructed above, configure
    #       the channel for binary data, and output the data to it.
    #
    set file_id [eval $command]
    fconfigure $file_id -encoding binary -translation \
        [expr {[isEagle] ? "protocol" : "auto"}]; # LOG DATA
    puts -nonewline $file_id $data; flush $file_id
    close $file_id
    return ""
  }
 
  proc readAsciiFile { fileName } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set file_id [open $fileName RDONLY]
    fconfigure $file_id -encoding ascii -translation auto; # ASCII TEXT
    set result [read $file_id]
    close $file_id
    return $result
  }
 
  proc writeAsciiFile { fileName data } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set file_id [open $fileName {WRONLY CREAT TRUNC}]
    fconfigure $file_id -encoding ascii -translation auto; # ASCII TEXT
    puts -nonewline $file_id $data
    close $file_id
    return ""
  }
 
  proc readUnicodeFile { fileName } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set file_id [open $fileName RDONLY]
    fconfigure $file_id -encoding unicode -translation auto; # UNICODE TEXT
    set result [read $file_id]
    close $file_id
    return $result
  }
 
  proc writeUnicodeFile { fileName data } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set file_id [open $fileName {WRONLY CREAT TRUNC}]
    fconfigure $file_id -encoding unicode -translation auto; # UNICODE TEXT
    puts -nonewline $file_id $data
    close $file_id
    return ""
  }
 
  proc getDirResultPath { pattern path } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #       Is the result path itself already absolute?
    #
    if {[file pathtype $path] eq "absolute"} then {
      #
      # NOTE: Ok, the result path is already absolute.
      #       Normalize and return it.
      #
      return [file normalize $path]
    } elseif {[file pathtype $pattern] eq "absolute"} then {
      #
      # NOTE: The pattern refers to an absolute path.  Strip
      #       the final part of the pattern and join it with
      #       the result path (which we already know is not
      #       absolute).
      #
      return [file normalize [file join [file dirname $pattern] $path]]
    } else {
      #
      # NOTE: Neither the result path nor the input pattern
      #       contain an absolute path; therefore, use the
      #       current directory to hang the result path on.
      #
      return [file normalize [file join [pwd] $path]]
    }
  }
 
  proc addToPath { dir } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    # NOTE: Normalize to an operating system native path.
    #
    set dir [file nativename $dir]

    #
    # NOTE: On Windows, use PATH; otherwise (i.e. Unix), use
    #       LD_LIBRARY_PATH.
    #
    if {$::tcl_platform(platform) eq "windows"} then {
      set name PATH
    } else {
      set name LD_LIBRARY_PATH
    }

    #
    # NOTE: Make sure the directory is not already in the
    #       loader search path.
    #
    if {[info exists ::tcl_platform(pathSeparator)]} then {
      set separator $::tcl_platform(pathSeparator)
    } elseif {$::tcl_platform(platform) eq "windows"} then {
      set separator \;
    } else {
      set separator :
    }

    #
    # NOTE: Does the necessary environment variable exist?
    #
    if {[info exists ::env($name)]} then {
      #
      # NOTE: Grab the value of the environment variable.
      #
      set value $::env($name)

      #
      # BUGBUG: Consider exact case only for now.
      #
      if {[lsearch -exact [split $value $separator] $dir] == -1} then {
        #
        # NOTE: Append the directory to the loader search path.
        #       This allows us to subsequently load DLLs that
        #       implicitly attempt to load other DLLs that are
        #       not in the application directory.
        #
        set ::env($name) [join [list $value $dir] $separator]

        #
        # NOTE: Yes, we altered the search path.
        #
        return true
      }
    } else {
      #
      # NOTE: Create the loader search path with the directory.
      #
      set ::env($name) $dir

      #
      # NOTE: Yes, we created the search path.
      #
      return true
    }

    #
    # NOTE: No, we did not alter the search path.
    #
    return false
  }
 
  proc removeFromPath { dir } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    # NOTE: Normalize to an operating system native path.
    #
    set dir [file nativename $dir]

    #
    # NOTE: On Windows, use PATH; otherwise (i.e. Unix), use
    #       LD_LIBRARY_PATH.
    #
    if {$::tcl_platform(platform) eq "windows"} then {
      set name PATH
    } else {
      set name LD_LIBRARY_PATH
    }

    #
    # NOTE: Make sure the directory is in the loader search
    #       path.
    #
    if {[info exists ::tcl_platform(pathSeparator)]} then {
      set separator $::tcl_platform(pathSeparator)
    } elseif {$::tcl_platform(platform) eq "windows"} then {
      set separator \;
    } else {
      set separator :
    }

    #
    # NOTE: We need to separate the directories in the path
    #       so that we can selectively remove the one we are
    #       looking for.
    #
    set dirs [split $::env($name) $separator]

    #
    # BUGBUG: Consider exact case only for now.
    #
    set index [lsearch -exact $dirs $dir]

    #
    # NOTE: Is the directory in the loader search path?
    #
    if {$index != -1} then {
      #
      # NOTE: Remove the directory from the loader search path.
      #
      set dirs [lreplace $dirs $index $index]

      #
      # NOTE: Replace the original loader search path with
      #       our modified one.
      #
      set ::env($name) [join $dirs $separator]

      #
      # NOTE: Yes, we altered the search path.
      #
      return true
    }

    #
    # NOTE: No, we did not alter the search path.
    #
    return false
  }
 
  proc execShell { 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 }

    lappend command [info nameofexecutable]
    eval lappend command $args

    return [uplevel 1 $command]
  }
 
  proc ldifference { list1 list2 } {
    set result [list]

    foreach element $list1 {
      if {[lsearch -exact $list2 $element] == -1} then {
        lappend result $element
      }
    }

    foreach element $list2 {
      if {[lsearch -exact $list1 $element] == -1} then {
        lappend result $element
      }
    }

    return $result
  }
 
  proc filter { list script } {
    set result [list]

    foreach item $list {
      if {[uplevel 1 $script [list $item]]} then {
        lappend result $item
      }
    }

    return $result
  }
 
  proc map { list script } {
    set result [list]

    foreach item $list {
      lappend result [uplevel 1 $script [list $item]]
    }

    return $result
  }
 
  proc reduce { list script } {
    set result ""

    foreach item $list {
      set result [uplevel 1 $script [list $result] [list $item]]
    }

    return $result
  }
 
  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: At this point, we need to require the test package so that
    #       we can run the test prologue.  Besides, the contained test(s)
    #       will almost certainly require access to procedures defined in
    #       our test package.
    #
    package require EagleTest

    #
    # 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 {
      error $result
    } else {
      return $result
    }
  }
 
  if {[isEagle]} then {
    ###########################################################################
    ############################ BEGIN Eagle ONLY #############################
    ###########################################################################

    proc isAdministrator {} {
      #
      # NOTE: Returns non-zero if the logged on user has full administrator
      #       rights on this machine.
      #
      return [expr {[info exists ::eagle_platform(administrator)] && \
          $::eagle_platform(administrator)}]
    }
 
    proc getPluginFlags { pattern } {
      foreach loaded [info loaded] {
        set plugin [lindex $loaded end]

        if {[regexp -- $pattern $plugin]} then {
          return [string map [list , " "] \
              [getDictionaryValue [info plugin $plugin] flags]]
        }
      }

      return [list]
    }
 
    proc getProcesses { name } {
      #
      # NOTE: Start with an empty list of process Ids.
      #
      set result [list]

      #
      # NOTE: Does the caller want processes matching a specific name
      #       or all processes on the local machine?
      #
      if {[string length $name] > 0} then {
        #
        # NOTE: Get the managed array of processes with matching names.
        #
        set array [object invoke -alias System.Diagnostics.Process \
            GetProcessesByName $name]
      } else {
        #
        # NOTE: Get the managed array of all processes on the local
        #       machine.
        #
        set array [object invoke -alias System.Diagnostics.Process \
            GetProcesses]
      }

      #
      # NOTE: For each process in the resulting array, grab the Id.
      #
      for {set index 0} {$index < [$array Length]} {incr index} {
        #
        # NOTE: Grab the Nth process array element value using the
        #       accessor method.
        #
        set process [$array -alias GetValue $index]

        #
        # NOTE: Add the Id of the process to the result list.
        #
        lappend result [$process Id]

        #
        # NOTE: Get rid of the process object, we no longer need it.
        #       Technically, it is not a requirement to explicitly
        #       unset variables that contain object references;
        #       however, it is useful in helping to document the
        #       code.
        #
        unset process; # dispose
      }

      #
      # NOTE: Get rid of the managed array of processes, we no longer
      #       need it.
      #
      unset array; # dispose

      #
      # NOTE: Return the list of process Ids, which may be empty.
      #
      return $result
    }
 
    proc waitForProcesses { ids timeout } {
      #
      # NOTE: Wait for each process in the list to exit.
      #
      foreach id $ids {
        #
        # NOTE: Get the process object by its Id.  If it does not exist,
        #       this will raise an error.
        #
        set result [catch {
          set process [object invoke -alias System.Diagnostics.Process \
              GetProcessById $id]
        }]

        #
        # NOTE: Were we able to grab the process object?
        #
        if {$result == 0 && [info exists process]} then {
          #
          # NOTE: Wait a while for the process to exit.
          #
          $process WaitForExit $timeout
        }

        #
        # NOTE: Get rid of the process (if we actually obtained it to
        #       begin with).
        #
        unset -nocomplain process; # dispose
      }
    }
 
    #
    # NOTE: This proc can be used to dynamically compile C# code in a script.
    #
    proc compileCSharp { string resultsVarName errorsVarName args } {
      #
      # NOTE: Create the C# code provider object (i.e. the compiler).
      #
      set provider [object create -alias Microsoft.CSharp.CSharpCodeProvider]

      #
      # NOTE: Create the object that provides various parameters to the C#
      #       code provider (i.e. the compiler options).
      #
      set parameters [object create -alias \
          System.CodeDom.Compiler.CompilerParameters]

      #
      # NOTE: By default, we do not want to persist the generated assembly
      #       to disk.
      #
      $parameters GenerateInMemory true

      #
      # NOTE: Process any extra compiler settings the caller may have
      #       provided.
      #
      foreach {name value} $args {
        $parameters -nocase $name $value
      }

      #
      # NOTE: Prepare to transfer the object reference to the caller.  We
      #       must use upvar here because otherwise the object is lost when
      #       the procedure call frame is cleaned up.
      #
      upvar 1 $resultsVarName results

      #
      # NOTE: Attempt to compile the specified string as C# and capture the
      #       results into the variable provided by the caller.
      #
      set results [$provider -alias CompileAssemblyFromSource $parameters \
          $string]

      #
      # NOTE: We no longer need the C# code provider object (i.e. the
      #       compiler); therefore, dispose it now.
      #
      unset provider; # dispose

      #
      # NOTE: Fetch the collection of compiler errors (which may be empty).
      #
      set errors [$results -alias Errors]

      #
      # NOTE: How many compile errors?
      #
      set count [$errors Count]

      #
      # NOTE: It is assumed that no assembly was generated if there were
      #       any compile errors.
      #
      if {$count > 0} then {
        #
        # NOTE: Compilation of the assembly failed.
        #
        set code Error

        #
        # NOTE: Prepare to transfer the error messages to the caller.
        #
        upvar 1 $errorsVarName local_errors

        for {set index 0} {$index < $count} {incr index} {
          #
          # NOTE: Get the compiler error object at this index.
          #
          set error [$errors -alias Item $index]

          #
          # NOTE: Convert it to a string and append it to the list of
          #       errors.
          #
          lappend local_errors [$error ToString]

          #
          # NOTE: Since the error itself is actually an object, we must
          #       dispose it.
          #
          unset error; # dispose
        }
      } else {
        #
        # NOTE: Compilation of the assembly succeeded.
        #
        set code Ok
      }

      #
      # NOTE: We no longer need the collection of compiler errors;
      #       therefore, dispose it now.
      #
      unset errors; # dispose

      return $code
    }
 
    proc matchEngineName { name } {
      return [expr {[string length $name] == 0 || \
          $name eq [info engine Name]}]
    }
 
    proc matchEngineCulture { culture } {
      return [expr {[string length $culture] == 0 || \
          $culture eq [info engine Culture]}]
    }
 
    proc escapeUpdateNotes { notes } {
      #
      # NOTE: Escape any embedded tab and line-ending characters.
      #
      return [string map \
          [list & &amp\; \t &htab\; \v &vtab\; \n &lf\; \r &cr\;] $notes]
    }
 
    proc unescapeUpdateNotes { notes } {
      #
      # NOTE: Unescape any embedded tab and line-ending characters.
      #
      return [string map \
          [list &htab\; \t &vtab\; \v &lf\; \n &cr\; \r &amp\; &] $notes]
    }
 
    proc getFetchUpdateArgs { baseUri patchLevel type directory extension } {
      #
      # NOTE: Initially, set the result to an empty list to indicate
      #       unrecognized input.
      #
      set result [list]

      #
      # NOTE: Make sure the base URI is valid.
      #
      if {[uri isvalid $baseUri]} then {
        #
        # NOTE: Make sure the patch level looks valid.
        #
        if {[regexp -- {^\d+\.\d+\.\d+\.\d+$} $patchLevel]} then {
          #
          # NOTE: Make sure the directory is either empty or an existing
          #       valid directory.
          #
          if {[string length $directory] == 0 || \
              [file isdirectory $directory]} then {
            #
            # NOTE: Make sure the extension is supported.
            #
            if {$extension eq ".exe" || $extension eq ".rar"} then {
              #
              # NOTE: Start with the URI components common to all download
              #       types.
              #
              set components [list $baseUri releases $patchLevel]

              #
              # NOTE: Next, figure out what type of download is being
              #       requested.
              #
              switch -exact -nocase -- $type {
                source {
                  #
                  # NOTE: Source code download.  This may be a RAR or an EXE
                  #       file.  Append the appropriate file name and then
                  #       join all the URI components to form the final URI.
                  #
                  set fileName [appendArgs EagleSource $patchLevel $extension]
                  lappend components $fileName

                  set result [list [eval uri join $components] \
                      [file join $directory $fileName]]
                }
                setup {
                  #
                  # NOTE: Windows setup download.  Always append an ".exe"
                  #       extension because we never distribute the setup as
                  #       a RAR file.  Append the appropriate file name and
                  #       then join all the URI components to form the final
                  #       URI.
                  #
                  set fileName [appendArgs EagleSetup $patchLevel .exe]
                  lappend components $fileName

                  set result [list [eval uri join $components] \
                      [file join $directory $fileName]]
                }
                binary {
                  #
                  # NOTE: Binary file download.  This may be a RAR or an EXE
                  #       file.  Append the appropriate file name and then
                  #       join all the URI components to form the final URI.
                  #
                  set fileName [appendArgs EagleBinary $patchLevel $extension]
                  lappend components $fileName

                  set result [list [eval uri join $components] \
                      [file join $directory $fileName]]
                }
              }
            }
          }
        }
      }

      return $result
    }
 
    proc fetchUpdate { baseUri patchLevel type directory } {
      #
      # NOTE: Figure out the appropriate file extension to download for
      #       this platform.
      #
      set extension [expr {$::tcl_platform(platform) eq "windows" ? \
          ".exe" : ".rar"}]

      #
      # NOTE: Build the necessary arguments for the download.
      #
      set args [getFetchUpdateArgs $baseUri $patchLevel $type \
          $directory $extension]

      if {[llength $args] > 0} then {
        #
        # NOTE: Temporarily start trusting ONLY our self-signed certificate
        #       which is used primarily for "software updates".
        #
        uri softwareupdates true

        try {
          #
          # NOTE: Download the file from the web site.
          #
          eval uri download $args; # synchronous.
        } finally {
          #
          # NOTE: Stop trusting ONLY our self-signed certificate which is
          #       used primarily for "software updates".
          #
          uri softwareupdates false
        }

        #
        # NOTE: Return a result indicating what was done.
        #
        return [appendArgs "downloaded URI " [lindex $args 0] \
            " to directory \"" $directory \"]
      } else {
        return "cannot fetch update, the URI is invalid"
      }
    }
 
    proc runUpdateAndExit {} {
      set directory [file dirname [info nameofexecutable]]

      set command [list exec -- \
          [file join $directory Hippogriff.exe] -delay 2000]

      eval $command &; exit -force
    }
 
    #
    # NOTE: This proc is used to check for new versions of the runtime
    #       when the user executes the interactive "#check" command.  To
    #       disable that functionality, redefine this proc to do nothing.
    #
    proc checkForUpdate {} {
      #
      # NOTE: This should work properly in Eagle only.
      #
      set uri [appendArgs [info engine Uri] [info engine UpdateFile]]
      set fileName [file tempname]; # unique local temp file name.

      #
      # NOTE: Temporarily start trusting ONLY our self-signed certificate
      #       which is used primarily for "software updates".
      #
      uri softwareupdates true

      try {
        #
        # NOTE: Download the tag file from the web site.
        #
        uri download $uri $fileName; # synchronous.
      } finally {
        #
        # NOTE: Stop trusting ONLY our self-signed certificate which is
        #       used primarily for "software updates".
        #
        uri softwareupdates false
      }

      #
      # NOTE: Read all the data out of the downloaded text file.
      #
      set data [readFile $fileName]

      #
      # NOTE: Remove the downloaded temporary file.  We no longer need
      #       it because we just read all the data from it.
      #
      file delete $fileName

      #
      # NOTE: Normalize to Unix line-endings.
      #
      set data [string map [list \r\n \n] $data]; # Unix.

      #
      # NOTE: Split the data into lines.
      #
      set lines [split $data \n]

      #
      # NOTE: Check each line to find the build information...
      #
      foreach line $lines {
        #
        # NOTE: Remove excess whitespace.
        #
        set line [string trim $line]

        #
        # NOTE: Skip blank lines.
        #
        if {[string length $line] > 0} then {
          #
          # NOTE: Skip comment lines.
          #
          if {[string index $line 0] ne "#" && \
              [string index $line 0] ne ";"} then {
            #
            # NOTE: Split the tab-delimited line into fields.  The format
            #       of the lines must be as follows:
            #
            # protocolId <tab> publicKeyToken <tab> name <tab> culture
            # <tab> patchLevel <tab> timeStamp <tab> uri <tab> md5Hash
            # <tab> sha1Hash <tab> sha512Hash <tab> notes <newLine>
            #
            set fields [split $line \t]

            #
            # NOTE: Grab the protocol Id field.
            #
            set protocolId [lindex $fields 0]

            #
            # NOTE: Grab the public key token field.
            #
            set publicKeyToken [lindex $fields 1]

            #
            # NOTE: Grab the name field.
            #
            set name [lindex $fields 2]

            #
            # NOTE: Grab the culture field.
            #
            set culture [lindex $fields 3]

            #
            # NOTE: We only want to find the first line that matches our
            #       engine.  The public key token is being used here to
            #       make sure we get the same "flavor" of the engine.
            #       The lines are organized so that the "latest stable
            #       version" is on the first line (for a given public key
            #       token), followed by development builds, experimental
            #       builds, etc.
            #
            if {$protocolId eq "1" && \
                $publicKeyToken eq [info engine PublicKeyToken] && \
                [matchEngineName $name] && \
                [matchEngineCulture $culture]} then {
              #
              # NOTE: Grab the patch level field.
              #
              set patchLevel [lindex $fields 4]

              if {[string length $patchLevel] == 0} then {
                set patchLevel 0.0.0.0; # no patch level?
              }

              #
              # NOTE: Grab the patch level for the running engine.
              #
              set enginePatchLevel [info engine PatchLevel]

              #
              # NOTE: Compare the patch level from the line to the one we
              #       are currently using.
              #
              set compare [package vcompare $patchLevel $enginePatchLevel]

              if {$compare > 0} then {
                #
                # NOTE: Grab the time-stamp field.
                #
                set timeStamp [lindex $fields 5]

                if {[string length $timeStamp] == 0} then {
                  set timeStamp 0; #never?
                }

                #
                # NOTE: Grab the base URI field (i.e. it may be a mirror
                #       site).
                #
                set baseUri [lindex $fields 6]

                if {[string length $baseUri] == 0} then {
                  set baseUri [info engine Uri]; # primary site.
                }

                #
                # NOTE: Grab the notes field (which may be empty).
                #
                set notes [lindex $fields 10]

                if {[string length $notes] > 0} then {
                  set notes [unescapeUpdateNotes $notes]
                }

                #
                # NOTE: Does it look like the number of seconds since the
                #       epoch or some kind of date/time string?
                #
                if {[string is integer -strict $timeStamp]} then {
                  set dateTime [clock format $timeStamp]
                } else {
                  set dateTime [clock format [clock scan $timeStamp]]
                }

                #
                # NOTE: The patch level from the line is greater, we are
                #       out-of-date.
                #
                return [list [appendArgs "newer build " $patchLevel \
                    " is available as of " $dateTime] [list $baseUri \
                    $patchLevel] [list $notes]]
              } elseif {$compare < 0} then {
                #
                # NOTE: The patch level from the line is less, we are more
                #       up-to-date than the latest version?
                #
                return [list [appendArgs "your build " $enginePatchLevel \
                    " is newer than the latest build " $patchLevel]]
              } else {
                #
                # NOTE: The patch levels are equal, we are up-to-date.
                #
                return [list "you have the latest build"]
              }
            }
          }
        }
      }

      return [list "cannot determine if your build is the latest"]
    }
 
    proc parray { a {pattern *} } {
      upvar 1 $a array

      if {![array exists array]} {
        error "\"$a\" isn't an array"
      }

      set names [lsort [array names array $pattern]]
      set maxLength 0

      foreach name $names {
        set length [string length $name]

        if {$length > $maxLength} {
          set maxLength $length
        }
      }

      set maxLength [expr {$maxLength + [string length $a] + 2}]
      set hostLength [lindex [host size] 0]
      set valueLength [expr {$hostLength - $maxLength - 5}]

      foreach name $names {
        #
        # NOTE: Format the array element name for display.
        #
        set nameString [appendArgs $a ( $name )]

        #
        # NOTE: If the value by itself is too long to fit on one host
        #       line, just truncate and ellipsis it.
        #
        set valueString $array($name)

        if {[string length $valueString] > $valueLength} then {
          set valueString [appendArgs [string range $valueString 0 \
              [expr {$valueLength - 4}]] " ..."]
        }

        #
        # HACK: Mono does not currently support calling the String.Format
        #       overload that takes a variable number of arguments via
        #       reflection (Mono bug #636939).
        #
        if {![isMono]} then {
          set line [string format -verbatim -- "{0,-$maxLength} = {1}" \
              $nameString $valueString]
        } else {
          set line [object invoke String Format "{0,-$maxLength} = {1}" \
              $nameString $valueString]
        }

        puts stdout $line
      }
    }
 
    proc pdict { d } {
      foreach {name value} $d {
        puts stdout "$name = $value"
      }
    }
 
    proc test { name description args } {
      #
      # NOTE: Determine if the caller is trying to run an old style or
      #       new style test and use the appropriate command.
      #
      if {[string index [lindex $args 0] 0] eq "-"} then {
        #
        # NOTE: New style test, use [test2] command.
        #
        set command test2
      } else {
        #
        # NOTE: Old style test, use [test1] command.
        #
        set command test1
      }

      return [uplevel 1 [list $command $name $description] $args]
    }
 
    proc unknown { name args } {
      #
      # NOTE: This is a stub unknown procedure that simply produces an
      #       appropriate error message.
      #
      # TODO: Add support for auto-loading packages here in the future?
      #
      return -code error "invalid command name \"$name\""
    }
 
    #
    # TODO: Revise or remove this procedure when full [namespace]
    #       support has been added.
    #
    proc ::tcl::tm::UnknownHandler { original name args } {
      #
      # NOTE: Do nothing except call the original handler.
      #
      uplevel 1 $original [::linsert $args 0 $name]
    }
 
    proc tclPkgUnknown { name args } {
      #
      # NOTE: Force a rescan of "pkgIndex" files.  This must be done in
      #       the global scope so that the special global variable 'dir'
      #       set by the package index loading subsystem can be accessed.
      #
      uplevel #0 [list package scan -host -normal -refresh]
    }
 
    proc tclLog { string } {
      #
      # NOTE: This should work properly in both Tcl and Eagle.
      #
      catch {puts stderr $string}
    }
 
    proc findDirectories { pattern } {
      #
      # NOTE: This should work properly in Eagle only.
      #
      set result [list]

      foreach dir [split [exec $::env(ComSpec) /c dir /ad /b \
          [appendArgs \" [file nativename $pattern] \"]] \n] {
        set dir [string trim $dir]

        if {[string length $dir] > 0} then {
          set dir [getDirResultPath $pattern $dir]

          if {[lsearch -exact -nocase $result $dir] == -1} then {
            lappend result $dir
          }
        }
      }

      foreach dir [split [exec $::env(ComSpec) /c dir /ahd /b \
          [appendArgs \" [file nativename $pattern] \"]] \n] {
        set dir [string trim $dir]

        if {[string length $dir] > 0} then {
          set dir [getDirResultPath $pattern $dir]

          if {[lsearch -exact -nocase $result $dir] == -1} then {
            lappend result $dir
          }
        }
      }

      return $result
    }
 
    proc findFiles { pattern } {
      #
      # NOTE: This should work properly in Eagle only.
      #
      set result [list]

      foreach fileName [split [exec $::env(ComSpec) /c dir /a-d /b \
          [appendArgs \" [file nativename $pattern] \"]] \n] {
        set fileName [string trim $fileName]

        if {[string length $fileName] > 0} then {
          set fileName [getDirResultPath $pattern $fileName]

          if {[lsearch -exact -nocase $result $fileName] == -1} then {
            lappend result $fileName
          }
        }
      }

      foreach fileName [split [exec $::env(ComSpec) /c dir /ah-d /b \
          [appendArgs \" [file nativename $pattern] \"]] \n] {
        set fileName [string trim $fileName]

        if {[string length $fileName] > 0} then {
          set fileName [getDirResultPath $pattern $fileName]

          if {[lsearch -exact -nocase $result $fileName] == -1} then {
            lappend result $fileName
          }
        }
      }

      return $result
    }
 
    proc findFilesRecursive { pattern } {
      #
      # NOTE: This should work properly in Eagle only.
      #
      set result [list]

      foreach fileName [split [exec $::env(ComSpec) /c dir /a-d /s /b \
          [appendArgs \" [file nativename $pattern] \"]] \n] {
        set fileName [string trim $fileName]

        if {[string length $fileName] > 0} then {
          set fileName [getDirResultPath $pattern $fileName]

          if {[lsearch -exact -nocase $result $fileName] == -1} then {
            lappend result $fileName
          }
        }
      }

      foreach fileName [split [exec $::env(ComSpec) /c dir /ah-d /s /b \
          [appendArgs \" [file nativename $pattern] \"]] \n] {
        set fileName [string trim $fileName]

        if {[string length $fileName] > 0} then {
          set fileName [getDirResultPath $pattern $fileName]

          if {[lsearch -exact -nocase $result $fileName] == -1} then {
            lappend result $fileName
          }
        }
      }

      return $result
    }
 
    ###########################################################################
    ############################# END Eagle ONLY ##############################
    ###########################################################################
  } else {
    ###########################################################################
    ############################# BEGIN Tcl ONLY ##############################
    ###########################################################################

    proc getLengthModifier { value } {
      #
      # NOTE: This should work properly in both Tcl and Eagle.
      #
      return [expr {int($value) != wide($value) ? "l" : ""}]
    }
 
    proc debug { args } {
      #
      # NOTE: This should work properly in both Tcl and Eagle.
      #
      puts stdout [lrange $args 2 end]
    }
 
    proc findDirectories { pattern } {
      #
      # NOTE: This should work properly in Tcl only.
      #
      eval lappend result [glob -nocomplain -types {d} \
          [file normalize $pattern]]

      eval lappend result [glob -nocomplain -types {d hidden} \
          [file normalize $pattern]]

      return $result
    }
 
    proc findFiles { pattern } {
      #
      # NOTE: This should work properly in Tcl only.
      #
      eval lappend result [glob -nocomplain -types {f} \
          [file normalize $pattern]]

      eval lappend result [glob -nocomplain -types {f hidden} \
          [file normalize $pattern]]

      return $result
    }
 
    proc findFilesRecursive { pattern } {
      #
      # NOTE: This should work properly in Tcl only.
      #
      set result [list]

      catch {
        foreach fileName [split [exec $::env(ComSpec) /c dir /a-d /s /b \
            [file nativename $pattern]] \n] {
          set fileName [string trim $fileName]

          if {[string length $fileName] > 0} then {
            set fileName [getDirResultPath $pattern $fileName]

            if {[lsearch -exact -nocase $result $fileName] == -1} then {
              lappend result $fileName
            }
          }
        }
      }

      catch {
        foreach fileName [split [exec $::env(ComSpec) /c dir /ah-d /s /b \
            [file nativename $pattern]] \n] {
          set fileName [string trim $fileName]

          if {[string length $fileName] > 0} then {
            set fileName [getDirResultPath $pattern $fileName]

            if {[lsearch -exact -nocase $result $fileName] == -1} then {
              lappend result $fileName
            }
          }
        }
      }

      return $result
    }
 
    proc exportAndImportPackageCommands { namespace exports forget force } {
      #
      # 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}::*
      }

      #
      # NOTE: Process each of the commands to be exported from this
      #       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.
        #
        if {$force || [llength [info commands ::$export]] == 0} then {
          namespace export $export

          if {$force} then {
            namespace eval :: [list namespace import -force \
                ${namespace}::$export]
          } else {
            namespace eval :: [list namespace import \
                ${namespace}::$export]
          }
        }
      }
    }
 
    #
    # 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 tsource \
        getPlatformInfo testShim] false false

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

###############################################################################
#
# pkgIndex.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Package Index File
#
# Copyright (c) 2007-2010 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: $
#
###############################################################################

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
if {![package vsatisfies [package provide Eagle] 1.0]} {return}

package ifneeded EagleLibrary 1.0 [list source [file join $dir init.eagle]]
package ifneeded EagleSafe 1.0 [list source [file join $dir safe.eagle]]
package ifneeded EagleShell 1.0 [list source [file join $dir shell.eagle]]
package ifneeded EagleTest 1.0 [list source [file join $dir test.eagle]]
package ifneeded NativeTcl 1.0 [list error "not native Tcl"]

###############################################################################
#
# pkgIndex.tcl --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Package Index File
#
# Copyright (c) 2007-2010 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: $
#
###############################################################################

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
if {[string length [package provide Eagle]] > 0} then {return}

package ifneeded EagleLibrary 1.0 [list source [file join $dir init.eagle]]
package ifneeded EagleSafe 1.0 [list source [file join $dir safe.eagle]]
package ifneeded EagleShell 1.0 [list source [file join $dir shell.eagle]]
package ifneeded EagleTest 1.0 [list source [file join $dir test.eagle]]
package ifneeded NativeTcl 1.0 [list package provide NativeTcl 1.0]

###############################################################################
#
# safe.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Safe Interpreter Initialization File
#
# Copyright (c) 2007-2010 by Joe Mistachkin.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: $
#
###############################################################################

#
# NOTE: Use our own namespace here because even though we do not directly
#       support namespaces ourselves, we do not want to pollute the global
#       namespace if this script actually ends up being evaluated in Tcl.
#
namespace eval ::Eagle {
  #
  # NOTE: This 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.
  #
  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.
    #       by the test suite).
    #
    return [expr {[info exists ::tcl_platform(engine)] && \
        [string compare -nocase eagle $::tcl_platform(engine)] == 0}]
  }
 
  if {[isEagle]} then {
    ###########################################################################
    ############################ BEGIN Eagle ONLY #############################
    ###########################################################################

    proc unknown { name args } {
      #
      # NOTE: This is a stub unknown procedure that simply produces an
      #       appropriate error message.
      #
      # TODO: Add support for auto-loading packages here in the future?
      #
      return -code error "invalid command name \"$name\""
    }
 
    #
    # TODO: Revise or remove this procedure when full [namespace] support has
    #       been added.
    #
    proc ::tcl::tm::UnknownHandler { original name args } {
      #
      # NOTE: Do nothing except call the original handler.
      #
      uplevel 1 $original [::linsert $args 0 $name]
    }
 
    proc tclPkgUnknown { name args } {
      #
      # NOTE: Do nothing since this is [most likely] a safe
      #       interpreter.
      #
      return
    }
 
    ###########################################################################
    ############################# END Eagle ONLY ##############################
    ###########################################################################
  }

  #
  # NOTE: Provide the Eagle "safe" package to the interpreter.
  #
  package provide EagleSafe \
    [expr {[isEagle] ? [info engine PatchLevel] : 1.0}]
}
 

###############################################################################
#
# shell.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Shell Initialization File
#
# Copyright (c) 2007-2010 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 {
  if {[isEagle]} then {
    ###########################################################################
    ############################ BEGIN Eagle ONLY #############################
    ###########################################################################

    #
    # NOTE: Commands specific to initializing the Eagle interactive shell
    #       environment should be placed here.
    #

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

    #
    # NOTE: Commands specific to initializing the Tcl interactive shell
    #       environment should be placed here.
    #

    ###########################################################################
    ############################## END Tcl ONLY ###############################
    ###########################################################################
  }

  #
  # NOTE: Provide the Eagle shell package to the interpreter.
  #
  package provide EagleShell \
    [expr {[isEagle] ? [info engine PatchLevel] : 1.0}]
}
 

###############################################################################
#
# test.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Test Initialization File
#
# Copyright (c) 2007-2010 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 tputs { 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
      }
    }

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

    if {[string length $fileName] > 0} then {
      appendSharedLogFile $fileName $string
    }
  }
 
  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 fixConstraints { constraints } {
    set result [string trim $constraints]

    if {[string length $result] > 0} then {
      #
      # HACK: Fixup for the magic expression (via [expr]) test
      #       constraint syntax supported by Tcltest and not by
      #       EagleTest.  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 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 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 {
          tputs $::test_channel [appendArgs \
              "---- error during $type file: " $error \n]

          #
          # NOTE: The error has been logged, now re-throw it.
          #
          error $error $::errorInfo $::errorCode
        }
      } else {
        tputs $::test_channel [appendArgs \
            "---- skipped $type file: \"" $fileName \
            "\", it does not exist\n"]
      }
    }
  }
 
  proc processTestArguments { varName args } {
    #
    # NOTE: We are going to place the configured options in
    #       the variable identified by the name provided by
    #       the caller.
    #
    upvar 1 $varName array

    #
    # TODO: Add more support for standard tcltest options here.
    #
    set options [list -configuration -suffix -file -notFile -match -skip \
        -constraints -logFile -threshold -stopOnFailure -exitOnComplete]

    foreach {name value} $args {
      if {[lsearch -exact $options $name] != -1} then {
        set array($name) $value

        tputs $::test_channel [appendArgs \
            "---- overrode test option \"" $name "\" with value \"" $value \
            \"\n]
      } else {
        tputs $::test_channel [appendArgs \
            "---- unknown test option \"" $name "\" with value \"" $value \
            "\" ignored\n"]
      }
    }
  }
 
  proc getTemporaryPath {} {
    #
    # NOTE: Build the list of "temporary directory" override
    #       environment variables to check.
    #
    set names [list]

    foreach name [list TEMP TMP] {
      #
      # NOTE: Make sure we handle all the reasonable "cases" of
      #       the environment variable names.
      #
      lappend names [string toupper $name]
      lappend names [string tolower $name]
      lappend names [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]} 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 getFiles { directory pattern } {
    if {[isEagle]} then {
      return [lsort -dictionary [file list $directory $pattern]]
    } else {
      return [lsort -dictionary [glob -directory $directory -types \
          {b c f p s} -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 {} {
    #
    # 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()}

      #
      # HACK: Mono does not currently support calling the String.Format
      #       overload that takes a variable number of arguments via
      #       reflection (Mono bug #636939).
      #
      if {![isMono]} then {
        return [string format "{0:X16}{1:X16}{2:X16}" \
            [clock now] [clock clicks] [expr $expr]]
      } else {
        #
        # NOTE: Strip any leading minus signs for cleanliness.
        #
        return [appendArgs \
            [string trimleft [clock now] -] \
            [string trimleft [clock clicks] -] \
            [string trimleft [expr $expr] -]]
      }
    } else {
      set seconds [clock seconds]; set clicks [clock clicks]
      binary scan [binary format d* [expr {rand()}]] w* random

      return [format [appendArgs % [getLengthModifier $seconds] X% \
          [getLengthModifier $clicks] X% [getLengthModifier $random] X] \
          $seconds $clicks $random]
    }
  }
 
  proc getTestLogId {} {
    return [expr {[info exists ::test_log_id] ? \
        [append result . $::test_log_id] : ""}]
  }
 
  proc getTestLog {} {
    return [expr {[info exists ::test_log] ? $::test_log : ""}]
  }
 
  proc testExec { commandName options args } {
    set command [list exec]

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

    lappend command --
    lappend command $commandName

    eval lappend command $args

    tputs $::test_channel [appendArgs "---- running command: " $command \n]

    return [uplevel 1 $command]
  }
 
  proc execTestShell { options args } {
    tputs $::test_channel [appendArgs \
        "---- running nested shell: exec " \
        [string trim [appendArgs $options " " -- " \"" \
        [info nameofexecutable] "\" " $args]] \n]

    return [uplevel 1 execShell [list $options] $args]
  }
 
  proc isStopOnFailure {} {
    return [expr {[info exists ::test_stop_on_failure] && \
                  [string is boolean -strict $::test_stop_on_failure] && \
                  $::test_stop_on_failure}]
  }
 
  proc isExitOnComplete {} {
    return [expr {[info exists ::test_exit_on_complete] && \
                  [string is boolean -strict $::test_exit_on_complete] && \
                  $::test_exit_on_complete}]
  }
 
  proc runTestPrologue {} {
    #
    # 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: 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 [lindex $args 0]]
        }
        2 {
          #
          # NOTE: Either -nonewline or channelId has been specified.
          #
          if {[string equal [lindex $args 0] -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 {[string equal [lindex $args 0] -nonewline]} then {
            set channel [lindex $args 1]
            set newLine ""
          }
        }
      }

      if {[info exists channel]} then {
        if {[string equal $channel 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 {
      if {$code == 0 && [regexp -- {\s==== (.*?) FAILED\s} $result]} then {
        set code 1
      }

      #
      # NOTE: Display and log the result of the test we just completed.
      #
      host result $code $result
      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 {
        host result Error "OVERALL RESULT: STOP-ON-FAILURE\n"
        tlog "OVERALL RESULT: STOP-ON-FAILURE\n"

        error ""; # no message
      }
    } else {
      if {$error} then {
        tputs $::test_channel [appendArgs "ERROR (runTest): " $result \n]
      }

      unhookPuts
    }
  }
 
  proc recordTestStatistics { varName index } {
    #
    # NOTE: Record counts of all object types that we track.
    #
    upvar 1 $varName array

    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(files,$index) [llength [getFiles $::test_path *]]
    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]]

    if {[isEagle]} then {
      set array(scopes,$index) [llength [scope list]]
      set array(objects,$index) [llength [info objects]]
      set array(callbacks,$index) [llength [info callbacks]]
      set array(types,$index) [llength [object types]]
      set array(interfaces,$index) [llength [object interfaces]]
      set array(namespaces,$index) [llength [object namespaces]]
      set array(processes,$index,list) [getProcesses ""]; # volatile, external
      set array(processes,$index) [llength $array(processes,$index,list)]
      set array(assemblies,$index) [llength [object assemblies]]

      #
      # 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(tclcommands,$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 {
        set array(tcl,$index) [tcl ready]
      }

      catch {set array(tclinterps,$index) [llength [tcl interps]]}
      catch {set array(tclcommands,$index) [llength [tcl command list]]}
    }
  }
 
  proc reportTestStatistics { channel fileName varName } {
    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 tclcommands; # assemblies
    }

    #
    # NOTE: Show what leaked, if anything.
    #
    upvar 1 $varName array

    foreach statistic $statistics {
      if {$array($statistic,after) > $array($statistic,before)} then {
        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]
        }
      }
    }
  }
 
  proc formatList { list {columns 1} } {
    set count 1
    set result ""

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

    return $result
  }
 
  proc formatListAsDict { list } {
    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>
      }
    }

    return $result
  }
 
  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}

    for {set index 0} {$index < [llength $patterns]} {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 runAllTests { channel path fileNames skipFileNames } {
    #
    # NOTE: Show the exact arguments we received since they may not
    #       have been displayed by the caller (or anybody else).
    #
    tputs $::test_channel [appendArgs "---- test run path: \"" $path \"\n]

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

    tputs $::test_channel [appendArgs "---- test run skip file names: " \
        [list $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 no files with failing tests.
    #
    set failed [list]

    #
    # NOTE: Process each file name we have been given by the caller...
    #
    foreach fileName $fileNames {
      #
      # 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 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.
          #
          if {[catch {uplevel 1 [list source $fileName]} error]} then {
            #
            # NOTE: Most likely, this error was caused by malformed or
            #       incorrect code in-between the tests themselves.  We
            #       need to report this.
            #
            tputs $::test_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
            }
          }

          #
          # NOTE: We evaluated another test file.
          #
          incr count

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

            #
            # NOTE: Determine if any resource leaks have occurred and
            #       output diagnostics as necessary if they have.
            #
            reportTestStatistics $channel $fileName leaks
          }
        }

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

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

    #
    # NOTE: Show the files that had failing tests.
    #
    if {[llength $failed] > 0} then {
      tputs $::test_channel [appendArgs "---- files with failing tests: " \
          $failed \n]
    }
  }
 
  proc configureTcltest { imports force } {
    if {[isEagle]} then {
      #
      # NOTE: Fake having the tcltest package.
      #
      package provide tcltest 2.2.10; # Tcl 8.4

      #
      # HACK: Compatibility shim(s) for use with various tests in the Tcl
      #       test suite.
      #
      interp alias {} testConstraint {} haveOrAddConstraint
      interp alias {} ::tcltest::testConstraint {} haveOrAddConstraint

      #
      # NOTE: This is needed by most tests in the Tcl test suite.
      #
      proc ::tcltest::cleanupTests {} {}
    } else {
      #
      # NOTE: Load the tcltest package.
      #
      package require tcltest

      #
      # NOTE: Configure tcltest for our use.
      #
      ::tcltest::configure -verbose bpste

      #
      # 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
      }
    }
  }
 
  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 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)
        }
      }
    }
 
    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 cleanupThread { thread } {
      if {[$thread IsAlive]} then {
        if {[catch {$thread Interrupt} error]} then {
          tputs $::test_channel [appendArgs \
              "---- failed to interrupt 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]
          }

          if {![$thread IsAlive]} then {
            tputs $::test_channel [appendArgs \
                "---- test thread \"" $thread "\" aborted\n"]

            return true; # aborted?
          }
        } else {
          tputs $::test_channel [appendArgs \
              "---- test thread \"" $thread "\" interrupted\n"]

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

      return false; # still alive (or error).
    }
 
    proc calculateBogoCops { {milliseconds 2000} } {
      set bgerror [interp bgerror {}]
      interp bgerror {} ""

      try {
        set flags [after flags]
        after flags =Immediate

        try {
          set event [after $milliseconds [list interp cancel]]

          set before [info cmdcount]
          catch {time {nop} -1}; # 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 {
            return [expr \
                {double(($after - $before) / ($milliseconds / 1000.0))}]
          } else {
            return [expr {($after - $before) / ($milliseconds / 1000.0)}]
          }
        } finally {
          catch {after cancel $event}
          after flags =$flags
        }
      } finally {
        interp bgerror {} $bgerror
      }
    }
 
    proc getMachineForTclShell {} {
      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 {puts -nonewline stdout $tcl_platform(machine)}

        #
        # 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 $::test_tclsh [list] \
            [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 error
        }
      } finally {
        #
        # NOTE: Did we create a temporary file?
        #
        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 machineToPlatform { machine } {
      switch -exact -nocase -- $machine {
        amd64 {
          return x64
        }
        intel {
          if {$::tcl_platform(platform) eq "windows"} then {
            return Win32
          } else {
            return x86
          }
        }
        default {
          return unknown
        }
      }
    }
 
    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
    }
 
    #
    # NOTE: Setup the test path relative to the library path.
    #
    if {![interp issafe] && ![info exists test_path]} then {
      #
      # NOTE: Try the source release directory structure.
      #
      set ::test_path [file join [file normalize [file dirname [file dirname \
          [info library]]]] Library Tests]

      if {![file exists $::test_path] || \
          ![file isdirectory $::test_path]} then {
        #
        # NOTE: Must be a binary release, no "Library" directory then.
        #       Also, binary releases have a lower-case "tests" directory
        #       name that originates from the "update.bat" tool.  Must
        #       match casing with "update.bat".
        #
        set ::test_path [file join [file normalize [file dirname [file dirname \
            [info library]]]] tests]
      }
    }

    #
    # NOTE: Fake having the tcltest package unless we are prevented.
    #
    if {![info exists ::no(configureTcltest)]} then {
      configureTcltest [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: Setup the test path relative to the path of this file.
    #
    if {![info exists test_path]} then {
      #
      # NOTE: Try the source release directory structure.
      #
      set ::test_path [file join [file normalize [file dirname \
          [file dirname [file dirname [info script]]]]] Library Tests]

      if {![file exists $::test_path] || \
          ![file isdirectory $::test_path]} then {
        #
        # NOTE: Must be a binary release, no "Library" directory then.
        #       Also, binary releases have a lower-case "tests" directory
        #       name that originates from the "update.bat" tool.  Must
        #       match casing with "update.bat".
        #
        set ::test_path [file join [file normalize [file dirname \
            [file dirname [file dirname [info script]]]]] tests]
      }
    }

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

    #
    # NOTE: We need several of our test related commands in the global
    #       namespace as well.
    #
    exportAndImportPackageCommands [namespace current] [list addConstraint \
        calculateRelativePerformance haveConstraint haveOrAddConstraint \
        processTestArguments getTemporaryPath getTestLog getTestLogId getFiles \
        getConstraints getTestFiles getTestRunId execTestShell runTestPrologue \
        runTestEpilogue runTest runAllTests fixConstraints sourceIfValid \
        isExitOnComplete getPassPercentage getSkipPercentage testExec tlog \
        tputs formatList configureTcltest] false false

    ###########################################################################
    ############################## END Tcl ONLY ###############################
    ###########################################################################
  }

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

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

source [file join $path common.eagle]

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

runTest {test basic-1.1 {simple INSERT / SELECT} -setup {
  set fileName [file join [getTemporaryPath] test.sqlite3]
  set connection [sql open -type SQLite [subst {Data Source=${fileName}}]]
} -body {
  set result [list]

  lappend result [sql execute -execute scalar $connection \
      "SELECT sqlite_source_id();"]

  sql execute $connection "CREATE TABLE t1(x INTEGER PRIMARY KEY ASC, y, z);"
  sql execute $connection "INSERT INTO t1 (x, y, z) VALUES(1, 'foo', 1234);"

  sql execute -execute reader $connection "SELECT * FROM t1;"

  foreach name [lsort [array names rows]] {
    lappend result [list $name $rows($name)]
  }

  set result
} -cleanup {
  catch {sql close $connection}
  catch {file delete $fileName}
  unset -nocomplain name rows result connection fileName
} -constraints {eagle monoBug28 command.sql compile.DATA} -match regexp \
-result {^\{\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2} [0-9a-f]{40}\} \{1 \{\{x 1\}\
\{y foo\} \{z 1234\}\}\} \{count 1\} \{names \{x y z\}\}$}}

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

runTestEpilogue

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

source [file join $path common.eagle]

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

runTest {test basic-1.1 {simple INSERT / SELECT} -setup {
  loadAssembly System.Data.SQLite.dll
  setupDb [set fileName basic-1.1.sqlite3]
} -body {
  set result [list]

  lappend result [sql execute -execute scalar $db \
      "SELECT sqlite_source_id();"]

  sql execute $db "CREATE TABLE t1(x INTEGER PRIMARY KEY ASC, y, z);"
  sql execute $db "INSERT INTO t1 (x, y, z) VALUES(1, 'foo', 1234);"

  sql execute -execute reader $db "SELECT * FROM t1;"

  foreach name [lsort [array names rows]] {
    lappend result [list $name $rows($name)]
  }

  set result
} -cleanup {
  cleanupDb $fileName

  unset -nocomplain name rows result db fileName
} -constraints {eagle monoBug28 command.sql compile.DATA} -match regexp \
-result {^\{\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2} [0-9a-f]{40}\} \{1 \{\{x 1\}\
\{y foo\} \{z 1234\}\}\} \{count 1\} \{names \{x y z\}\}$}}

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

runTestEpilogue

#
# Written by Joe Mistachkin.
# Released to the public domain, use at your own risk!
#
###############################################################################

if {[isEagle]} then {

  object load -loadtype File [file join [file dirname $path] bin \

      [expr {[haveConstraint imageRuntime40] ? "2010" : "2008"}] \
      $test_configuration bin System.Data.SQLite.dll]
}

#
# Written by Joe Mistachkin.
# Released to the public domain, use at your own risk!
#
###############################################################################

if {[isEagle]} then {
  proc loadAssembly { fileName } {
    object load -loadtype File \
        [file join [file dirname $::path] bin \
        [expr {[haveConstraint imageRuntime40] ? "2010" : "2008"}] \
        $::test_configuration bin $fileName]
  }
 
  proc setupDb {fileName {varName db}} {
    set fileName [file join [getTemporaryPath] $fileName]
    catch {file delete $fileName}
    upvar 1 $varName db
    set db [sql open -type SQLite [subst {Data Source=${fileName}}]]
  }
 
  proc cleanupDb {fileName {varName db}} {
    upvar 1 $varName db
    catch {sql close $db}
    catch {file delete $fileName}
  }
}

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

source [file join $path common.eagle]

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





runTest {test tkt-2c630bffa7-1.1 {floating point type ranges} -setup {

  set fileName [file join [getTemporaryPath] tkt-2c630bffa7-1.1.sqlite3]
  set connection [sql open -type SQLite [subst {Data Source=${fileName}}]]
} -body {
  sql execute $connection "CREATE TABLE t1(x INTEGER, y REAL);"
  sql execute $connection "CREATE TABLE t2(x INTEGER, y FLOAT);"
  sql execute $connection "CREATE TABLE t3(x INTEGER, y DOUBLE);"

  set y [list -1.79769e308 -3.40282e038 -1 0 1 3.40282e038 1.79769e308]




  set result [list]

  foreach t [list t1 t2 t3] {

















    for {set x 0} {$x < [llength $y]} {incr x} {
      sql execute $connection \
          "INSERT INTO $t (x, y) VALUES($x, [lindex $y $x]);"
    }

    sql execute -execute reader $connection \
      "SELECT x, y FROM $t ORDER BY x;"



    for {set x 1} {$x <= [llength $y]} {incr x} {
      lappend result [getRowColumnValue rows $x y]



    }

  }






  set result







} -cleanup {
  catch {sql close $connection}
  catch {file delete $fileName}

  unset -nocomplain x y t result rows connection fileName
} -constraints {eagle monoBug28 command.sql compile.DATA} -result \
{-1.79769E+308 -3.40282E+38 -1 0 1 3.40282E+38 1.79769E+308 -1.79769E+308\
-3.40282E+38 -1 0 1 3.40282E+38 1.79769E+308 -1.79769E+308 -3.40282E+38 -1 0 1\
3.40282E+38 1.79769E+308}}






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

runTestEpilogue

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

source [file join $path common.eagle]

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

set y [list -1.79769e308 -3.40282e038 -1 0 1 3.40282e038 1.79769e308]

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

runTest {test tkt-2c630bffa7-1.1 {range of REAL type} -setup {
  loadAssembly System.Data.SQLite.dll
  setupDb [set fileName tkt-2c630bffa7-1.1.sqlite3]

} -body {
  sql execute $db "CREATE TABLE t1(x INTEGER, y REAL);"




  for {set x 0} {$x < [llength $y]} {incr x} {
    sql execute $db \
        "INSERT INTO t1 (x, y) VALUES($x, [lindex $y $x]);"
  }



  set result [sql execute -execute reader -format list $db \
    "SELECT x, y FROM t1 ORDER BY x;"]
} -cleanup {
  cleanupDb $fileName

  unset -nocomplain x result db fileName
} -constraints {eagle monoBug28 command.sql compile.DATA} -result \
{0 -1.79769E+308 1 -3.40282E+38 2 -1 3 0 4 1 5 3.40282E+38 6 1.79769E+308}}

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

runTest {test tkt-2c630bffa7-1.2 {range of FLOAT type} -setup {
  loadAssembly System.Data.SQLite.dll
  setupDb [set fileName tkt-2c630bffa7-1.2.sqlite3]
} -body {
  sql execute $db "CREATE TABLE t2(x INTEGER, y FLOAT);"

  for {set x 0} {$x < [llength $y]} {incr x} {
    sql execute $db \
        "INSERT INTO t2 (x, y) VALUES($x, [lindex $y $x]);"
  }

  set result [sql execute -execute reader -format list $db \
    "SELECT x, y FROM t2 ORDER BY x;"]
} -cleanup {
  cleanupDb $fileName



  unset -nocomplain x result db fileName
} -constraints {eagle monoBug28 command.sql compile.DATA} -result \
{0 -1.79769E+308 1 -3.40282E+38 2 -1 3 0 4 1 5 3.40282E+38 6 1.79769E+308}}

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

runTest {test tkt-2c630bffa7-1.3 {range of DOUBLE type} -setup {
  loadAssembly System.Data.SQLite.dll
  setupDb [set fileName tkt-2c630bffa7-1.3.sqlite3]
} -body {
  sql execute $db "CREATE TABLE t3(x INTEGER, y DOUBLE);"


  for {set x 0} {$x < [llength $y]} {incr x} {
    sql execute $db \
        "INSERT INTO t3 (x, y) VALUES($x, [lindex $y $x]);"
  }

  set result [sql execute -execute reader -format list $db \
    "SELECT x, y FROM t3 ORDER BY x;"]
} -cleanup {

  cleanupDb $fileName

  unset -nocomplain x result db fileName
} -constraints {eagle monoBug28 command.sql compile.DATA} -result \



{0 -1.79769E+308 1 -3.40282E+38 2 -1 3 0 4 1 5 3.40282E+38 6 1.79769E+308}}

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

unset -nocomplain y

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

runTestEpilogue