System.Data.SQLite
Artifact Content
Not logged in

Artifact d3170b76d41c24e0688a9fa9a8a9b136ece20e81:


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