############################################################################### # # constraints.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Test Constraints File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { proc getKnownCompileOptions {} { return [list \ APPDOMAINS APPROVED_VERBS ARM ASSEMBLY_RELEASE \ ASSEMBLY_STRONG_NAME_TAG ASSEMBLY_TAG ASSEMBLY_TEXT ASSEMBLY_URI \ BREAK_ON_EXITING BREAKPOINTS CACHE_ARGUMENT_TOSTRING \ CACHE_ARGUMENTLIST_TOSTRING CACHE_DICTIONARY CACHE_RESULT_TOSTRING \ CACHE_STATISTICS CACHE_STRINGLIST_TOSTRING CALLBACK_QUEUE CAS_POLICY \ CODE_ANALYSIS COM_TYPE_CACHE CONSOLE DAEMON DATA DEAD_CODE DEBUG \ DEBUGGER DEBUGGER_ARGUMENTS DEBUGGER_ENGINE DEBUGGER_EXECUTE \ DEBUGGER_EXPRESSION DEBUGGER_VARIABLE DEBUG_TRACE DEBUG_WRITE DRAWING \ DYNAMIC EAGLE EMBEDDED_LIBRARY EXECUTE_CACHE EXPRESSION_FLAGS \ FAST_ERRORCODE FAST_ERRORINFO HAVE_SIZEOF HISTORY IA64 \ INTERACTIVE_COMMANDS INTERNALS_VISIBLE_TO ISOLATED_INTERPRETERS \ ISOLATED_PLUGINS LIBRARY LICENSING LIST_CACHE MONO MONO_BUILD \ MONO_HACKS MONO_LEGACY NATIVE NATIVE_PACKAGE NATIVE_UTILITY \ NATIVE_UTILITY_BSTR NETWORK NET_20 NET_20_FAST_ENUM NET_20_ONLY \ NET_20_SP1 NET_20_SP2 NET_30 NET_35 NET_40 NET_45 NET_451 NET_452 \ NON_WORKING_CODE NOTIFY NOTIFY_ACTIVE NOTIFY_ARGUMENTS \ NOTIFY_EXCEPTION NOTIFY_EXECUTE NOTIFY_EXPRESSION NOTIFY_GLOBAL \ NOTIFY_OBJECT OBSOLETE OFFICIAL PARSE_CACHE PATCHLEVEL POLICY_TRACE \ PREVIOUS_RESULT RANDOMIZE_ID REMOTING SAMPLE SERIALIZATION \ SHARED_ID_POOL SHELL SOURCE_ID SOURCE_TIMESTAMP STATIC TCL TCL_KITS \ TCL_THREADED TCL_THREADS TCL_UNICODE TCL_WRAPPER TEST THREADING \ THROW_ON_DISPOSED TRACE TYPE_CACHE UNIX VERBOSE WEB WINDOWS WINFORMS \ WIX_30 WIX_35 WIX_36 WIX_37 WIX_38 X64 X86 XML] } proc getKnownMonoVersions {} { # # NOTE: This job of this procedure is to return the list of "known" # versions of Mono supported by the test suite infrastructure. # return [list \ [list 2 0] [list 2 2] [list 2 4] [list 2 6] [list 2 8] [list 2 10] \ [list 2 11] [list 2 12] [list 3 0] [list 3 1] [list 3 2] [list 3 3] \ [list 3 4] [list 3 5] [list 3 6]] } # # NOTE: This procedure was adapted from the one listed on the Tcl Wiki page # at "http://wiki.tcl.tk/43". It is only intended to be used on very # small lists because of its heavy use of recursion and complexity on # the order of O(N!). # proc lpermute { list } { set length [llength $list] if {$length < 2} { return [list $list] } set index 0 foreach element1 $list { if {$index == 0} then { set rest [lrange $list 1 end] } elseif {$index == $length - 1} then { set rest [lrange $list 0 end-1] } else { set rest [concat \ [lrange $list 0 [expr {$index - 1}]] \ [lrange $list [expr {$index + 1}] end]] } incr index foreach list2 [lpermute $rest] { lappend result [concat [list $element1] $list2] } } return $result } proc alwaysFullInterpReady {} { # # NOTE: The [interp readylimit] sub-command is only in Eagle. # if {![isEagle]} then { return true } # # NOTE: If this Eagle version lacks [interp readylimit] -OR- it has # the default value (i.e. it always fully checks readiness), # return true. # return [expr { [catch {interp readylimit {}} readylimit] != 0 || $readylimit == 0 }] } # # NOTE: This procedure should return non-zero if the native Tcl shell may # be executed by the test suite infrastructure outside the context # of any specific tests. The specific tests themselves must make # use of their own constraints to prevent execution of the native # Tcl shell. # proc canExecTclShell {} { if {[info exists ::no(exec)]} then { return false } if {[info exists ::no(tcl)]} then { return false } if {[info exists ::no(canExecTclShell)]} then { return false } return true } # # NOTE: This procedure should return non-zero if Fossil may be executed by # the test suite infrastructure outside the context of any specific # tests. The specific tests themselves must make use of their own # constraints to prevent execution of Fossil. # proc canExecFossil {} { if {[info exists ::no(exec)]} then { return false } if {[info exists ::no(fossil)]} then { return false } if {[info exists ::no(canExecFossil)]} then { return false } return true } proc checkForTestSuiteFiles { channel } { tputs $channel "---- checking for test suite files... " # # NOTE: Start out with no test suite files to check. # set fileNames [list] # # NOTE: Check if the base package path is available. # if {[info exists ::test_package_path]} then { # # TODO: If additional test suite files are added within the base # package path, add them here as well. # foreach fileNameOnly [list \ embed.eagle init.eagle pkgIndex.eagle pkgIndex.tcl \ safe.eagle shell.eagle test.eagle vendor.eagle word.tcl] { # # NOTE: First, check if the file resides in the Eagle-specific # package sub-directory. Failing that, fallback to using # the base package path itself. # set fileName [file join \ $::test_package_path Eagle1.0 $fileNameOnly] if {![file exists $fileName]} then { set fileName [file join $::test_package_path $fileNameOnly] } # # NOTE: If the test suite file exists, add it to the list of file # names to process. # if {[file exists $fileName]} then { lappend fileNames $fileName } } } # # NOTE: Check if the test package path is available. # if {[info exists ::test_path]} then { # # TODO: If additional test suite files are added within the test # package path, add them here as well. # foreach fileNameOnly [list \ all.eagle constraints.eagle epilogue.eagle pkgIndex.eagle \ pkgIndex.tcl prologue.eagle] { # # NOTE: Check if the file resides in the test package directory. # set fileName [file join $::test_path $fileNameOnly] # # NOTE: If the test suite file exists, add it to the list of file # names to process. # if {[file exists $fileName]} then { lappend fileNames $fileName } } } # # NOTE: Did we find any test suite files? # if {[llength $fileNames] > 0} then { # # NOTE: Eagle has a built-in hashing command; however, Tcl requires # a package. Make sure we can hash content before proceeding. # if {[isEagle] || [catch {package require sha1}] == 0} then { tputs $channel yes\n foreach fileName $fileNames { if {[isEagle]} then { # # NOTE: Use the relatively new -filename option to the Eagle # [hash] command. # set sha1 [hash normal -filename sha1 $fileName] } else { # # BUGBUG: Apparently, the ActiveState tcllib sha1 package may # have a bug that produces the wrong values here. No # attempt is made here to work around any such bug. # For further information, please see: # # http://core.tcl.tk/tcllib/info/ad20454023 # set sha1 [sha1::sha1 -hex -filename $fileName] } tputs $channel [appendArgs \ "---- file \"" $fileName "\"... sha1 (" $sha1 ")\n"] } # # NOTE: We are done here, return now. # return } } tputs $channel no\n } proc checkForPlatform { channel } { tputs $channel "---- checking for platform... " if {[info exists ::tcl_platform(platform)]} then { addConstraint $::tcl_platform(platform) tputs $channel [appendArgs $::tcl_platform(platform) \n] } else { tputs $channel unknown\n } ########################################################################### if {![isEagle]} then { # # BUGFIX: We do not normally want to skip any Mono bugs in native Tcl. # if {![info exists ::no(runtimeVersion)]} then { # # NOTE: Add the necessary constraints for each version of Mono that # we know about. # foreach monoVersion [getKnownMonoVersions] { set constraintVersion [join $monoVersion ""] addConstraint [appendArgs monoToDo $constraintVersion] addConstraint [appendArgs monoToDo $constraintVersion Only] addConstraint [appendArgs monoBug $constraintVersion] addConstraint [appendArgs monoBug $constraintVersion Only] addConstraint [appendArgs monoCrash $constraintVersion] addConstraint [appendArgs monoCrash $constraintVersion Only] } # # NOTE: Also add just the generic Mono constraints that do not have # a trailing version. # set constraints [list monoToDo monoBug monoCrash] foreach constraint $constraints { addConstraint $constraint } } } } proc checkForWindowsVersion { channel } { tputs $channel "---- checking for Windows version... " # # NOTE: Are we running on Windows at all? # if {[isWindows]} then { # # NOTE: Is the specific OS name and version number available? # if {[info exists ::tcl_platform(os)] && \ [string length $::tcl_platform(os)] > 0 && \ [info exists ::tcl_platform(osVersion)] && \ [string length $::tcl_platform(osVersion)] > 0 && \ [regexp -- {^\d+\.\d+$} $::tcl_platform(osVersion)]} then { # # NOTE: Start out with the OS name, removing all spaces. # set version [appendArgs \ [string map [list " " ""] $::tcl_platform(os)] _ \ $::tcl_platform(osVersion)] # # NOTE: Add constraint containing the OS name and version number. # addConstraint [appendArgs osVersion. $version] # # NOTE: Show what we found for the OS name and version number. # tputs $channel [appendArgs "yes (" $::tcl_platform(os) " v" \ $::tcl_platform(osVersion) ")\n"] # # NOTE: We are done here, return now. # return } } tputs $channel no\n } proc checkForScriptLibrary { channel } { tputs $channel "---- checking for script library... " # # NOTE: See if the variable containing the script library location # exists. # if {[info exists ::tcl_library] && \ [string length $::tcl_library] > 0} then { # # NOTE: Now see if the script library is external or embedded. # if {[file isdirectory $::tcl_library]} then { # # NOTE: Yes, it appears to be a directory name, which should # mean that the necessary files are physically contained # within it. # addConstraint tcl_library_external tputs $channel "yes (external)\n" # # NOTE: We are done here, return now. # return } elseif {[file isfile $::tcl_library]} then { # # NOTE: Yes, it appears to be a file name, which should mean # that the necessary files are physically embedded within # it. # addConstraint tcl_library_embedded tputs $channel "yes (embedded)\n" # # NOTE: We are done here, return now. # return } } tputs $channel no\n } proc checkForVariable { channel name {notEmpty true} {constraint ""} } { tputs $channel [appendArgs "---- checking for variable \"" $name \ "\"... "] # # NOTE: First, normalize the variable name to be in the global scope. # set newName [appendArgs :: [string trimleft $name :]] # # NOTE: Next, always check if it actually exists (as of right now). # if {[info exists $newName]} then { # # NOTE: Next, optionally check if it constains anything. # if {!$notEmpty || [string length [set $newName]] > 0} then { # # NOTE: The variable exists and it either contains something # or we do not care about its contents. # if {[string length $constraint] > 0} then { addConstraint [appendArgs variable_ $constraint] } else { addConstraint [appendArgs variable_ [string trimleft $newName :]] } # # NOTE: Show that we found the variable and whether it actually # contained anything. # tputs $channel [appendArgs "yes (" \ [expr {$notEmpty ? "exists, not empty" : "exists"}] ")\n"] # # NOTE: We are done here, return now. # return } } tputs $channel no\n } proc checkForTclOptions { channel } { tputs $channel "---- checking for Tcl options... " if {![isEagle]} then { set result [list] # # NOTE: This test constraint is needed by test "benchmark-1.22". # if {![info exists ::no(compileNative)]} then { lappend result compile.NATIVE addConstraint compile.NATIVE } # # NOTE: This test constraint is needed by test "benchmark-1.22". # if {![info exists ::no(compileWindows)]} then { # # NOTE: If the current platform is Windows the Tcl binary must have # been compiled for Windows. # if {[isWindows]} then { lappend result compile.WINDOWS addConstraint compile.WINDOWS } } # # NOTE: This test constraint is needed by tests "socket-*.*". # if {![info exists ::no(compileNetwork)]} then { lappend result compile.NETWORK addConstraint compile.NETWORK } # # NOTE: Just fake the invariant culture when running in native Tcl. # if {![info exists ::no(culture)]} then { lappend result culture.invariant addConstraint culture.invariant } tputs $channel [appendArgs "yes (" $result ")\n"] } else { tputs $channel no\n } } proc checkForWindowsCommandProcessor { channel pattern {constraint ""} } { tputs $channel "---- checking for Windows Command Processor... " if {[isWindows]} then { # # NOTE: Grab the "ComSpec" from the Windows environment and make sure it # matches the file pattern supplied by the caller (e.g. "cmd.exe"). # if {[info exists ::env(ComSpec)] && \ [string match -nocase $pattern [file tail $::env(ComSpec)]]} then { # # NOTE: We are running with a matching command processor. # if {[string length $constraint] > 0} then { addConstraint [appendArgs comSpec_ $constraint] } else { addConstraint [appendArgs comSpec_ \ [string map [list * _ - _ ? _ \[ _ \\ _ \] _] $pattern]] } tputs $channel [appendArgs "yes (\"" $::env(ComSpec) "\")\n"] # # NOTE: We are done here, return now. # return } } tputs $channel no\n } proc checkForFossil { channel } { tputs $channel "---- checking for Fossil... " if {[canExecFossil] && \ [catch {exec -- fossil version} version] == 0} then { set version [string trim $version] set pattern {^This is fossil version (.*) \[([0-9a-f]+)\]\ \d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2} UTC$} if {[regexp -- $pattern $version dummy version sourceId]} then { # # NOTE: Add a constraint to show that the Fossil executable # itself is available. # addConstraint fossil_version # # NOTE: Append the version of Fossil currently in use. # append result version " " $version " \[" $sourceId \] if {[canExecFossil] && \ [catch {exec -- fossil remote} remote] == 0} then { set remote [string trim $remote]; set valid false if {[isEagle]} then { # # NOTE: With Eagle, we can actually validate the URI. # if {[uri isvalid $remote]} then { set valid true } } else { # # HACK: Currently, there is no simple way to validate # an arbitrary URI with Tcl (i.e. without using # some hideously complex regular expression). # if {[string length $remote] > 0} then { set valid true } } if {$valid} then { # # NOTE: Add a constraint to show that a valid Fossil # repository URI appears to be available. # addConstraint fossil_repository # # NOTE: If we are not prevented from doing so, save the # test repository to the repository URI currently # in use to a suitably named global variable. # if {![info exists ::no(setRepository)]} then { set ::test_repository $remote } # # NOTE: Append the repository URI currently in use. # append result ", repository \"" $remote \" # # NOTE: Show the result of the checking. # tputs $channel [appendArgs "yes (" $result ")\n"] # # NOTE: We are done here, return now. # return } } } } tputs $channel no\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 checkForSymbols { channel name {constraint ""} } { set fileName [file normalize [appendArgs [file rootname $name] .pdb]] tputs $channel [appendArgs "---- checking for symbols \"" $fileName \ "\"... "] if {[file exists $fileName]} then { # # NOTE: The file appears to have associated symbols available. # if {[string length $constraint] > 0} then { addConstraint [appendArgs symbols_ $constraint] } else { addConstraint [appendArgs symbols_ [file tail $name]] } tputs $channel yes\n } else { tputs $channel no\n } } proc checkForLogFile { channel } { tputs $channel "---- checking for log file... " if {[info exists ::test_log] && \ [string length $::test_log] > 0 && \ [file exists $::test_log]} then { # # NOTE: The log file appears to be available. # addConstraint logFile tputs $channel yes\n } else { 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 checkForTk { channel } { tputs $channel "---- checking for Tk... " # # HACK: For now, disable testing Tk 8.4/8.5 when running in Eagle. # if {![isEagle] || [haveConstraint tclLibrary86]} then { addConstraint tk 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 tcl84Feature addConstraint tcl84OrLower addConstraint tcl84OrHigher addConstraint tcl85OrLower 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 tcl84Feature addConstraint tcl84OrHigher addConstraint tcl85 addConstraint tcl85Feature addConstraint tcl85OrLower addConstraint tcl85OrHigher 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 tcl84Feature addConstraint tcl84OrHigher addConstraint tcl85Feature addConstraint tcl85OrHigher addConstraint tcl86 addConstraint tcl86Feature addConstraint tcl86OrLower addConstraint tcl86OrHigher } 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 [appendArgs command. $name] tputs $channel yes\n } else { tputs $channel no\n } } proc checkForNamespaces { channel quiet } { tputs $channel "---- checking for namespace support... " if {[isEagle]} then { # # NOTE: Check if namespace support was compiled into the core library # (i.e. this is beta 30 or later). # set available false if {[catch {string length [object invoke \ Type GetType Eagle._Commands.Namespace2]} length] == 0 && \ [set available [expr {$length > 0}]]} then { addConstraint namespaces.available } else { addConstraint namespaces.unavailable } if {[catch {object invoke -flags +NonPublic Interpreter.GetActive \ AreNamespacesEnabled} enabled] == 0} then { # # NOTE: We were able to query for namespace support (i.e. this # must be beta 29 or later); however, we still need to # check if it has been enabled at runtime. # if {$enabled} then { # # NOTE: Yes, it appears that it is available and enabled. # addConstraint namespaces tputs $channel enabled\n } else { tputs $channel disabled\n # # NOTE: Check if namespace support was compiled into the core # library (i.e. is this beta 30 or later). # if {!$quiet && $available} then { # # NOTE: The tests seem to be running with namespace support # available, but disabled. Emit a warning into the # test log file. # tputs $channel \ "==== WARNING: running with namespaces available and disabled\n" } } } else { tputs $channel error\n } } else { # # NOTE: All supported versions of native Tcl have namespaces enabled # and available. # addConstraint namespaces.available addConstraint namespaces tputs $channel enabled\n } } proc checkForTestExec { channel quiet } { tputs $channel "---- checking for test use of \"exec\" command... " set procName [lindex [info level [info level]] 0] if {![info exists ::no(testExec)] && [canTestExec $procName]} then { addConstraint testExec tputs $channel yes\n if {!$quiet && [info exists ::no(exec)]} then { tputs $channel \ "==== WARNING: running with the \"testExec\" procedure disabled\n" } } else { tputs $channel no\n } } proc checkForTestMachine { channel } { tputs $channel "---- checking for test machine... " if {[info exists ::test_machine] && \ [string length $::test_machine] > 0} then { addConstraint [appendArgs machine. $::test_machine] tputs $channel [appendArgs $::test_machine \n] } else { tputs $channel unknown\n } } proc checkForTestPlatform { channel } { tputs $channel "---- checking for test platform... " if {[info exists ::test_platform] && \ [string length $::test_platform] > 0} then { addConstraint [appendArgs platform. $::test_platform] tputs $channel [appendArgs $::test_platform \n] } else { tputs $channel unknown\n } } proc checkForTestConfiguration { channel } { tputs $channel "---- checking for test configuration... " if {[info exists ::test_configuration] && \ [string length $::test_configuration] > 0} then { addConstraint [appendArgs configuration. $::test_configuration] tputs $channel [appendArgs $::test_configuration \n] } else { tputs $channel unknown\n } } proc checkForTestSuffix { channel } { tputs $channel "---- checking for test suffix... " if {[info exists ::test_suffix] && \ [string length $::test_suffix] > 0} then { addConstraint [appendArgs suffix. $::test_suffix] tputs $channel [appendArgs $::test_suffix \n] } else { tputs $channel unknown\n } } proc checkForFile { channel name {constraint ""} } { tputs $channel [appendArgs "---- checking for file \"" \ [file normalize $name] "\"... "] if {[file exists $name]} then { # # NOTE: Yes, it appears that it is available. # if {[string length $constraint] > 0} then { addConstraint [appendArgs file_ $constraint] } else { addConstraint [appendArgs 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 [appendArgs file_ $constraint] } else { addConstraint [appendArgs 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 {[isWindows]} 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 {[isWindows]} 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 [appendArgs file_ $constraint] } else { addConstraint [appendArgs 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 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 checkForTip207 { channel } { tputs $channel "---- checking for TIP #207... " # # NOTE: Is the interpreter TIP #207 ready? # catch {interp invokehidden {} -namespace -- info} error if {![string match {bad option "-namespace": *} $error]} then { addConstraint tip207 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... " if {[alwaysFullInterpReady]} then { # # NOTE: Is the interpreter TIP #285 ready? # catch {interp cancel} error if {$error eq "eval canceled"} then { addConstraint tip285 tputs $channel yes\n # # NOTE: We are done here, return now. # return } } tputs $channel no\n } proc checkForTip405 { channel } { tputs $channel "---- checking for TIP #405... " # # NOTE: Does the interpreter have TIP #405 (i.e. [lmap])? # catch {lmap} error if {$error ne "invalid command name \"lmap\""} then { addConstraint tip405 tputs $channel yes\n } else { tputs $channel no\n } } proc checkForTip426 { channel } { tputs $channel "---- checking for TIP #426... " # # NOTE: Is the interpreter TIP #426 ready? # catch {info cmdtype} error if {$error eq {wrong # args: should be "info cmdtype commandName"}} then { addConstraint tip426 tputs $channel yes\n } else { tputs $channel no\n } } proc checkForTip429 { channel } { tputs $channel "---- checking for TIP #429... " # # NOTE: Is the interpreter TIP #429 ready? # if {[catch {string cat}] == 0} then { addConstraint tip429 tputs $channel yes\n } else { tputs $channel no\n } } proc checkForTiming { channel threshold {constraint ""} {tries 1} {delay 1000} {average false} {asynchronous false} } { tputs $channel [appendArgs \ "---- checking for precision timing (threshold of " $threshold \ " milliseconds" [expr {$average ? " average" : ""}] ", delay of " \ $delay " milliseconds)... "] # # HACK: Sometimes the first try takes quite a bit longer than subsequent # tries. We attempt to bypass this problem by retrying a set number # of times (which can be overridden by the caller) before giving up. # set total 0 set difference unknown for {set try 0} {$try < $tries} {incr try} { # # NOTE: Create a script that will set the final clicks value. This must # use a global variable due to the nature of [after]. # set stopScript { set ::stopClicks [expr {[clock clicks -milliseconds] & 0x7fffffff}] } # # NOTE: Set the initial clicks value and then attempt to wait for about # one second, either synchronously or asynchronously, depending on # the preference of the caller. # set start [expr {[clock clicks -milliseconds] & 0x7fffffff}] if {$asynchronous} then { set event [after $delay $stopScript]; vwait ::stopClicks } else { after $delay; eval $stopScript } # # NOTE: Move the final clicks value from the global frame to this one. # set stop $::stopClicks; unset ::stopClicks # # NOTE: Calculate the difference between the actual and expected # number of milliseconds. # set difference [expr {abs($stop - $start - $delay)}] # # NOTE: Keep track of the total number of milliseconds elapsed for # all iterations of this loop. # incr total $difference # # NOTE: If we are using the average difference, handle that now. # if {$average && $tries > 1} then { set difference [expr {$total / $tries}] } # # NOTE: Are we within the threshold specified by the caller? # if {$difference >= 0 && $difference <= $threshold} then { # # NOTE: We appear to be capable of fairly precise timing. # if {[string length $constraint] == 0} then { set constraint timing } addConstraint $constraint tputs $channel [appendArgs \ "yes (0 <= " $difference " <= " $threshold " milliseconds" \ [expr {$average ? " average" : ""}] ", tried " [expr {$try + 1}] \ " out of " $tries " " [expr {$tries > 1 ? "times" : "time"}] \ ", \"" $constraint "\")\n"] # # NOTE: We are done here, return now. # return } } tputs $channel [appendArgs \ "no (0 <= " $difference " > " $threshold " milliseconds" \ [expr {$average ? " average" : ""}] ", tried " $try " out of " \ $tries " " [expr {$tries > 1 ? "times" : "time"}] ")\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 checkForBigLists { channel } { tputs $channel "---- checking for big list testing... " # # NOTE: Are we allowed to do big list testing? # if {![info exists ::no(bigLists)]} then { if {[isEagle]} then { # # MONO: Using the native utility library when running on Mono to # join big lists seems to cause StackOverflowException to # be thrown. # if {[info exists ::no(mono)] || ![isMono] || \ ![haveConstraint nativeUtility]} then { # # NOTE: Yes, it appears that it is available. # addConstraint bigLists tputs $channel yes\n } else { tputs $channel "no, broken on Mono with native utility\n" } } else { addConstraint bigLists tputs $channel yes\n } } else { tputs $channel no\n } } proc checkForMemoryIntensive { channel } { tputs $channel "---- checking for memory intensive testing... " # # NOTE: Are we allowed to do memory intensive testing? # if {![info exists ::no(memoryIntensive)]} then { addConstraint memoryIntensive tputs $channel yes\n } else { tputs $channel no\n } } proc checkForStackIntensive { channel } { tputs $channel "---- checking for stack intensive testing... " # # NOTE: Are we allowed to do stack intensive testing? # if {![info exists ::no(stackIntensive)]} then { if {[isEagle]} then { # # NOTE: Attempt to query for native stack checking in Eagle. # if {[catch {object invoke -flags +NonPublic \ Eagle._Components.Private.NativeStack CanQueryThread} \ canQueryThread] == 0 && \ $canQueryThread} then { # # NOTE: Yes, it appears that it is available. # addConstraint stackIntensive tputs $channel yes\n } else { tputs $channel no\n } } else { addConstraint stackIntensive 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 checkForInteractiveCommand { channel name } { tputs $channel [appendArgs "---- checking for interactive command \"" \ $name "\"... "] # # NOTE: Currently, only Eagle has "interactive commands". # if {[isEagle]} then { # # NOTE: Attempt to query the interactive command names from Eagle. # if {[catch {object invoke Utility GetInteractiveCommandNames $name \ false} names] == 0 && \ [llength $names] > 0} then { # # NOTE: Yes, it appears that it is available. # addConstraint [appendArgs interactiveCommand. $name] tputs $channel yes\n # # NOTE: We are done here, return now. # return } } 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 { # # NOTE: Running this check on the Mono 3.3.0 (or 3.4.0?) release build # will lock up the process; therefore, skip it in that case. # if {[info exists ::no(mono)] || ![isMono] || \ (![haveConstraint mono33] && ![haveConstraint mono34])} 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 [appendArgs network_ $host] tputs $channel [appendArgs "yes (" $response ")\n"] } else { tputs $channel no\n } } else { tputs $channel "skipped, may hang on Mono 3.3.0 and 3.4.0\n" } } else { # # HACK: Running in Tcl, just assume we have network access. # addConstraint [appendArgs network_ $host] tputs $channel yes\n } } proc checkForCompileOption { channel option } { tputs $channel [appendArgs "---- checking for compile option \"" \ $option "\"... "] if {[isEagle]} then { if {[info exists ::eagle_platform(compileOptions)] && \ [lsearch -exact -nocase $::eagle_platform(compileOptions) \ $option] != -1} then { # # NOTE: Yes, support for the Eagle compile option is present. # addConstraint [appendArgs compile. $option] tputs $channel yes\n } else { tputs $channel no\n } } else { # # NOTE: We are running inside Tcl; however, we need to check for an # Eagle compile option. This can now be accomplished via the # [eagle] command supplied by the Eagle Package for Tcl, if # it is actually loaded and available. # if {[llength [info commands eagle]] > 0} then { set options [eagle [list expr {[info exists \ ::eagle_platform(compileOptions)] ? \ $::eagle_platform(compileOptions) : [list]}]] if {[lsearch -exact $options $option] != -1} then { # # NOTE: Yes, support for the Eagle compile option is present. # addConstraint [appendArgs compile. $option] tputs $channel yes\n # # NOTE: We are done here, return now. # return } } tputs $channel no\n } } proc checkForKnownCompileOptions { channel } { # # NOTE: Check for all "known" compile options. # tputs $channel "---- checking for known compile options... " set options [getKnownCompileOptions] if {[llength $options] > 0} then { tputs $channel [appendArgs "yes (" [llength $options] ")\n"] foreach option $options { if {![info exists [appendArgs ::no(compile. $option )]]} then { checkForCompileOption $channel $option } } } else { tputs $channel no\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} trust] == 0 && \ $trust 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 checkForManagedDebuggingAssistants { channel } { set fileName [file normalize [appendArgs [info nameofexecutable] \ .mda.config]] tputs $channel [appendArgs \ "---- checking for managed debugging assistants enabled via \"" \ $fileName "\"... "] if {[file exists $fileName]} then { # # NOTE: Since the System.Xml assembly may not be loaded, wrap the # detection in a [catch] block. # if {[catch { # # NOTE: Create and load an XML document based on the data from the # MDA configuration file associated with the executable that # started this process. # set document [object create -alias System.Xml.XmlDocument] $document LoadXml [readFile $fileName] # # NOTE: Setup the XML namespace manager for use when using XPath # to query the XML document. # set nameTable [$document NameTable] set namespaceManager [object create \ -alias System.Xml.XmlNamespaceManager $nameTable] $namespaceManager AddNamespace mda \ http://schemas.microsoft.com/CLR/2004/10/mda # # NOTE: Select all nodes underneath the location where they should # reside in the MDA configuration XML document. # set nodes [$document SelectNodes \ /mda:mdaConfig/mda:assistants/* $namespaceManager] # # NOTE: Populate the local result variable with the names of # all the XML nodes found. # set names [object lmap -alias node $nodes { $node Name }] }] == 0} then { # # NOTE: Ok, the XML configuration file was loaded and parsed # correctly, see if any managed debugging assistants were # found enabled within it. # if {[info exists names] && [llength $names] > 0} then { # # NOTE: Add a test constraint for each managed debugging # assistant that appears to be enabled. # addConstraint mda foreach name $names { addConstraint [appendArgs mda. $name] } # # NOTE: Save the list of managed debugging assistants for # later use by the test suite. # if {![info exists ::no(setMdas)]} then { set ::test_mdas $names } # # NOTE: Yes, it appears that at least one managed debugging # assistant is enabled. # tputs $channel [appendArgs "yes (" $names ")\n"] # # NOTE: We are done here, return now. # return } } } tputs $channel no\n } proc checkForStrongName { channel } { tputs $channel "---- checking for strong name... " if {[catch {object invoke Interpreter.GetActive GetStrongName} \ strongName] == 0 && \ [string length $strongName] > 0} then { # # NOTE: Yes, it appears that the core library was signed with a # strong name key. # addConstraint strongName tputs $channel yes\n } else { tputs $channel no\n } } proc checkForCertificate { channel } { tputs $channel "---- checking for certificate... " if {[catch {object invoke Interpreter.GetActive GetCertificate} \ certificate] == 0 && \ [string length $certificate] > 0} then { # # NOTE: Yes, it appears that the core library was signed with a # code-signing certificate. # addConstraint certificate tputs $channel [appendArgs "yes (" \ [object invoke $certificate Subject] ")\n"] } else { tputs $channel no\n } } proc checkForCompileCSharp { channel } { tputs $channel "---- checking for test use of C# compiler... " if {![info exists ::no(compileCSharp)]} then { addConstraint compileCSharp tputs $channel yes\n } else { tputs $channel no\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 {[catch {host isopen} open] == 0} then { if {$open} then { addConstraint hostIsOpen tputs $channel open\n } else { if {[catch {host redirected Input} redirected] == 0} then { if {$redirected} then { addConstraint hostInputRedirected tputs $channel redirected\n } else { addConstraint hostIsClosed tputs $channel closed\n } } else { tlog $redirected; tputs $channel error\n } } } else { tlog $open; tputs $channel error\n } } proc checkForHostType { channel } { tputs $channel "---- checking for host type... " if {[set code [catch {object invoke \ Interpreter.GetActive.Host.GetType ToString} hostType]] == 0 && \ [string length $hostType] > 0} then { addConstraint [appendArgs hostType. [string map \ [list , _ + _ & _ * _ \[ _ \] _ . _ \\ _] $hostType]] tputs $channel [appendArgs $hostType \n] } elseif {$code == 0} then { tputs $channel unknown\n } else { tputs $channel error\n } } proc checkForPrimaryThread { channel } { tputs $channel "---- checking for primary thread... " if {[catch {object invoke Interpreter.GetActive ThreadId} \ threadId] == 0 && \ [info tid] == $threadId} then { addConstraint primaryThread tputs $channel [appendArgs "yes (" $threadId ")\n"] } else { tputs $channel [appendArgs "no (" $threadId ")\n"] } } proc checkForDefaultAppDomain { channel } { tputs $channel "---- checking for default application domain... " if {[catch {object invoke AppDomain CurrentDomain} appDomain] == 0 && \ [string length $appDomain] > 0} then { if {[object invoke $appDomain IsDefaultAppDomain]} then { addConstraint defaultAppDomain tputs $channel [appendArgs "yes (" [object invoke $appDomain Id] \ ")\n"] } else { tputs $channel [appendArgs "no (" [object invoke $appDomain Id] \ ")\n"] } } else { tputs $channel [appendArgs "no (null)\n"] } } proc checkForRuntime { channel } { tputs $channel "---- checking for runtime... " # # NOTE: Are we running inside Mono (regardless of operating system)? # if {![info exists ::no(mono)] && [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 [appendArgs imageRuntime $version] tputs $channel [appendArgs $::eagle_platform(imageRuntimeVersion) \ " " ( $dotVersion ) \n] } else { tputs $channel no\n } } proc checkForFrameworkVersion { channel } { tputs $channel "---- checking for framework version... " if {[info exists ::eagle_platform(frameworkVersion)] && \ [string length $::eagle_platform(frameworkVersion)] > 0} then { # # NOTE: Get the major and minor portions of the version only. # set dotVersion [join [lrange [split \ $::eagle_platform(frameworkVersion) .] 0 1] .] # # NOTE: Now create a version string for use in the constraint name # (remove the periods). # set version [string map [list . ""] $dotVersion] # # NOTE: If the framework version was found, add a test constraint # for it now. # if {[string length $version] > 0} then { addConstraint [appendArgs framework $version] } tputs $channel [appendArgs $::eagle_platform(frameworkVersion) \ " " ( $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 {![info exists ::no(mono)] && [isMono]} then { # # NOTE: If the runtime version was found, add a test constraint # for it now. # if {[string length $version] > 0} then { # # NOTE: We are running on Mono. Keep track of the specific # version for usage in test constraints. # addConstraint [appendArgs mono $version] addConstraint [appendArgs mono $version OrHigher] } # # NOTE: Attempt to parse the version into its major and minor # components. # if {[string length $dotVersion] > 0 && [regexp -- {^(\d+)\.(\d+)$} \ $dotVersion dummy majorVersion minorVersion]} then { # # NOTE: This is the list of Mono versions to add test # constraints for. # set monoVersions [list] # # NOTE: Check each Mono version "known" to the test suite. # foreach monoVersion [getKnownMonoVersions] { # # NOTE: Check for any Mono major version X or higher. # if {$majorVersion >= [lindex $monoVersion 0]} then { # # NOTE: Check for any Mono major/minor version higher # than X.Y. # if {$majorVersion > [lindex $monoVersion 0] || \ $minorVersion > [lindex $monoVersion 1]} then { # # NOTE: Add this "known" version of Mono. # lappend monoVersions $monoVersion } } } # # NOTE: Add the necessary constraints for each version of Mono # we should NOT skip bugs for. # foreach monoVersion $monoVersions { set constraintVersion [join $monoVersion ""] addConstraint [appendArgs mono $constraintVersion OrHigher] addConstraint [appendArgs monoToDo $constraintVersion] addConstraint [appendArgs monoBug $constraintVersion] addConstraint [appendArgs monoCrash $constraintVersion] } # # NOTE: Check all known versions of Mono for an exact match with # the currently running one. # foreach monoVersion [getKnownMonoVersions] { # # NOTE: Check if Mono major/minor version is exactly the one # we are currently processing. # set constraintVersion [join $monoVersion ""] if {[lindex $monoVersion 0] == $majorVersion && \ [lindex $monoVersion 1] == $minorVersion} then { # # NOTE: Add test constraints that only apply to this exact # version of Mono. # addConstraint [appendArgs mono $constraintVersion Only] } else { # # NOTE: Add test constraints that apply to all versions of # Mono except this exact version. # addConstraint [appendArgs monoToDo $constraintVersion Only] addConstraint [appendArgs monoBug $constraintVersion Only] addConstraint [appendArgs monoCrash $constraintVersion Only] } } } } else { # # NOTE: If the runtime version was found, add a test constraint # for it now. # 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 [appendArgs dotNet $version] addConstraint [appendArgs dotNet $version OrHigher] } # # 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 [getKnownMonoVersions] { set constraintVersion [join $monoVersion ""] addConstraint [appendArgs monoToDo $constraintVersion] addConstraint [appendArgs monoToDo $constraintVersion Only] addConstraint [appendArgs monoBug $constraintVersion] addConstraint [appendArgs monoBug $constraintVersion Only] addConstraint [appendArgs monoCrash $constraintVersion] addConstraint [appendArgs monoCrash $constraintVersion Only] } } tputs $channel [appendArgs $::eagle_platform(runtimeVersion) \ " " ( $dotVersion ) \n] } else { tputs $channel no\n } } proc checkForProcessBits { channel } { tputs $channel "---- checking for process bits... " if {[info exists ::tcl_platform(processBits)] && \ [string is integer -strict $::tcl_platform(processBits)]} then { addConstraint [appendArgs $::tcl_platform(processBits) bit] tputs $channel [appendArgs $::tcl_platform(processBits) -bit\n] } else { tputs $channel unknown\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(processBits)]} then { # # NOTE: Does the machine and number of bits match # what the caller specified? # if {$::tcl_platform(machine) eq $machine && \ $::tcl_platform(processBits) eq $bits} then { # # NOTE: Yes, it matches. # addConstraint [appendArgs $machine . $bits bit] set result yes } else { set result no } tputs $channel [appendArgs $result ", " $::tcl_platform(processBits) \ -bit " " $::tcl_platform(machine) \n] } else { tputs $channel "no, unknown\n" } } proc checkForGarudaDll { channel } { # # NOTE: Skip automatic Tcl shell machine detection if we are not # allowed to execute external commands. # if {[canExecTclShell]} then { # # NOTE: Have the [getGarudaDll] procedure automatically detect the # machine. # set machine "" } else { # # NOTE: Use the machine for this test run. # set machine [getTestMachine] # # NOTE: Since an empty string means "automatically detect" to the # [getGarudaDll] procedure, we must make sure the value is # something else. # if {[string length $machine] == 0} then { set machine unknown } } # # NOTE: Check for the Garuda DLL of the same platform (i.e. machine # type) as the native Tcl shell. # return [checkForFile $channel [getGarudaDll $machine]] } 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 [appendArgs culture. [string map [list - _] $culture]] tputs $channel [appendArgs $culture \n] } else { tputs $channel unknown\n } } proc checkForThreadCulture { channel } { tputs $channel "---- checking for thread culture... " # # NOTE: Grab the current thread culture. # if {[catch {object invoke System.Threading.Thread.CurrentThread \ CurrentCulture} culture] == 0 && \ [catch {object invoke Eagle._Components.Private.FormatOps \ CultureName $culture false} culture] == 0 && \ [string length $culture] > 0} then { # # NOTE: The culture information is present, use it and show it. # addConstraint [appendArgs threadCulture. [string map [list - _] \ $culture]] tputs $channel [appendArgs $culture \n] } else { tputs $channel unknown\n } } proc checkForQuiet { channel quiet } { if {!$quiet} then { tputs $channel "---- checking for quiet... " } if {[catch { object invoke Interpreter.GetActive Quiet } isQuiet] == 0 && $isQuiet} then { # # NOTE: Yes, quiet mode is enabled. # addConstraint quiet if {!$quiet} then { tputs $channel yes\n } } else { if {!$quiet} then { tputs $channel no\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 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 [appendArgs 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 {[isWindows] || ([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 {[isWindows] || [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 checkForWoW64 { channel } { tputs $channel "---- checking for WoW64... " if {[info exists ::eagle_platform(wow64)] && \ [string is boolean -strict $::eagle_platform(wow64)] && \ $::eagle_platform(wow64)} then { # # NOTE: Yes, we are running in a WoW64 process. # addConstraint wow64 tputs $channel yes\n } else { 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 type 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 -type $type $string} connection] == 0} then { # # NOTE: Yes, it appears that we can connect to the local database. # addConstraint database # # NOTE: Also record the test database connection type used as a # test constraint. # if {[string length $type] > 0} then { addConstraint [appendArgs database. [string tolower $type]] } # # 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 {constraint ""} } { 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. # if {[string length $constraint] > 0} then { addConstraint [appendArgs member_ $constraint] } else { addConstraint [appendArgs $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} ready] == 0 && $ready} then { # # NOTE: Yes, native Tcl is loaded and ready. # addConstraint tclReady # # NOTE: Yes, native Tcl is ready -OR- available. # addConstraint tclReadyOrLibrary # # NOTE: Ok, attempt to determine the loaded Tcl version. # if {[catch { tcl eval [tcl master] {info tclversion} } version] == 0 && [regexp -- {^\d+\.\d+$} $version]} then { addConstraint [appendArgs \ tclReady [string map [list . ""] $version]] # # NOTE: The Tcl library is ready; however, we need to add the # appropriate test constraint to indicate that a specific # version of Tcl is "either ready or available". # if {[haveConstraint tclLibrary86] && $version >= 8.6} then { addConstraint tclReadyOrLibrary86 } elseif {[haveConstraint tclLibrary85] && $version >= 8.5} then { addConstraint tclReadyOrLibrary85 } elseif {[haveConstraint tclLibrary84] && $version >= 8.4} then { addConstraint tclReadyOrLibrary84 } tputs $channel [appendArgs "yes (" $version ")\n"] } else { # # NOTE: The Tcl library is ready; however, we have no idea what # version it actually is; therefore, skip adding the test # constraint to indicate that a specific version of Tcl # is "either ready or available". # tputs $channel yes\n } } else { # # NOTE: The Tcl library is not ready; however, we still need to add # the appropriate test constraint to indicate that a specific # version of Tcl is "either ready or available". # if {[haveConstraint tclLibrary86]} then { addConstraint tclReadyOrLibrary86 } elseif {[haveConstraint tclLibrary85]} then { addConstraint tclReadyOrLibrary85 } elseif {[haveConstraint tclLibrary84]} then { addConstraint tclReadyOrLibrary84 } tputs $channel no\n } } proc checkForTclShell { channel } { # # HACK: If this returns "error" that normally indicates an error was # caught during [exec] (i.e. the native Tcl shell could not be # executed). # set prefix "---- checking for Tcl shell version... " if {[canExecTclShell] && \ [catch {getTclVersionForTclShell} version] == 0 && \ $version ne "error"} then { # # NOTE: Yes, a native Tcl shell appears to be available. # addConstraint tclShell # # NOTE: Now, add the version specific test constraint. # addConstraint [appendArgs \ tclShell [string map [list . ""] $version]] tputs $channel [appendArgs $prefix "yes (" $version ")\n"] } else { tputs $channel [appendArgs $prefix no\n] } } proc checkForTkPackage { channel } { # # HACK: We do not care about the Tk version 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). # set prefix "---- checking for Tk package version... " if {[canExecTclShell] && \ [catch {getTkVersionForTclShell} version] == 0 && \ $version ne "error"} then { # # NOTE: Yes, a native Tk package appears to be available. # addConstraint tkPackage tputs $channel [appendArgs $prefix "yes (" $version ")\n"] } else { tputs $channel [appendArgs $prefix 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 {[isWindows]} 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. Make # sure to look in the WoW64 registry because WiX is currently # always installed as a 32-bit application. # set key [appendArgs HKEY_LOCAL_MACHINE\\ \ [getSoftwareRegistryKey true] {\Microsoft\Windows Installer XML}] # # NOTE: The versions of WiX that we support. # set versions [list 3.7 3.6 3.5 3.0] # # NOTE: Check each version, stopping when one is found. # foreach version $versions { # # NOTE: Attempt to fetch the WiX install directory value from the # registry, removing the trailing backslash, if any. Does # the directory name look valid and does it actually exist? # if {[catch {file normalize [string trimright [object invoke \ Microsoft.Win32.Registry GetValue [appendArgs $key \\ \ $version] InstallRoot null] \\]} directory] == 0 && \ [string length $directory] > 0 && \ [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 "" } } } } # # 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. # if {![info exists ::no(setWix)]} then { 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 checkForTargetFramework { channel } { tputs $channel "---- checking for target framework... " if {[info exists ::eagle_platform(targetFramework)] && \ [string length $::eagle_platform(targetFramework)] > 0} then { # # NOTE: Now create a string for use in the constraint name (remove # the invalid characters). For example: # # ".NETFramework,Version=v2.0" --> "NETFramework.Version.v2.0" # set targetFramework [string trimleft [string map [list , . = .] \ $::eagle_platform(targetFramework)] .] # # NOTE: Keep track of the specific target framework for usage in test # constraints. # addConstraint [appendArgs targetFramework. $targetFramework] tputs $channel [appendArgs $::eagle_platform(targetFramework) \ " " ( $targetFramework ) \n] } else { tputs $channel no\n } } proc checkForNativeUtility { channel } { tputs $channel "---- checking for native utility... " if {[info exists ::eagle_platform(nativeUtility)] && \ [string length $::eagle_platform(nativeUtility)] > 0} then { set name [lindex $::eagle_platform(nativeUtility) 0] if {[string length $name] > 0} then { set version [lindex $::eagle_platform(nativeUtility) 1] if {[string length $version] > 0} then { set nativeUtility [appendArgs \ $name . [join [lrange [split $version .] 0 1] .]] } else { set nativeUtility $name } if {$nativeUtility ni "disabled unavailable"} then { addConstraint nativeUtility } addConstraint [appendArgs nativeUtility. $nativeUtility] tputs $channel [appendArgs $::eagle_platform(nativeUtility) \ " " ( $nativeUtility ) \n] } else { tputs $channel unknown\n } } else { tputs $channel no\n } } proc checkForNetFx45 { channel } { tputs $channel "---- checking for .NET Framework 4.5... " # # NOTE: Platform must be Windows for this constraint to even be # checked (i.e. we require the registry). # if {[isWindows]} then { # # NOTE: Registry hive where the .NET Framework 4.0 setup and # servicing information is stored. No need to look in # the WoW64 registry because the .NET Framework should # be installed natively as well. # set key [appendArgs HKEY_LOCAL_MACHINE\\ \ {Software\Microsoft\NET Framework Setup\NDP\v4\Full}] # # NOTE: Attempt to fetch the .NET Framework 4.0 "release" value from # the servicing registry hive. If this value does not exist # -OR- is less than 378389, then the .NET Framework 4.5 is not # installed. # set release [object invoke Microsoft.Win32.Registry GetValue $key \ Release null] if {[string is integer -strict $release] && $release >= 378389} then { # # NOTE: Yes, it appears that it is available. # addConstraint dotNet45OrHigher # # NOTE: If the "release" value is greater than or equal to 378758, # then the .NET Framework 4.5.1 is installed. # if {$release >= 378758} then { addConstraint dotNet451 addConstraint dotNet451OrHigher set version 4.5.1 } else { addConstraint dotNet45 set version 4.5 } # # NOTE: Show the "release" value we found in the registry. # tputs $channel [appendArgs "yes (" $release ", " $version ")\n"] # # NOTE: We are done here, return now. # return } } tputs $channel no\n } proc checkForVisualStudio { channel } { tputs $channel "---- checking for Visual Studio... " # # NOTE: Platform must be Windows for this constraint to even be # checked (i.e. we require the registry). # set visualStudioVersions [list] if {[isWindows]} then { # # NOTE: Registry hive where Visual Studio install information is # stored. Make sure to look in the WoW64 registry because # Visual Studio is currently always a 32-bit application. # set key [appendArgs HKEY_LOCAL_MACHINE\\ \ [getSoftwareRegistryKey true] {\Microsoft\VisualStudio}] # # NOTE: The versions of Visual Studio that we support. # set versions [list [list 8.0 2005] [list 9.0 2008] \ [list 10.0 2010] [list 11.0 2012] [list 12.0 2013]] # # NOTE: Check each version and keep track of the ones we find. # foreach version $versions { # # NOTE: Attempt to fetch the Visual Studio install directory # value from the registry, removing the trailing backslash, # if any. Does the directory name look valid and does it # actually exist? # if {[catch {file normalize [file join [string trimright [object \ invoke Microsoft.Win32.Registry GetValue [appendArgs $key \\ \ [lindex $version 0]] InstallDir null] \\] msenv.dll]} \ fileName] == 0 && \ [string length $fileName] > 0 && [file isfile $fileName]} then { # # NOTE: Yes, it appears that it is available. # addConstraint [appendArgs visualStudio [lindex $version 1]] # # NOTE: Keep track of all the versions that we find. # lappend visualStudioVersions [lindex $version 1] # # NOTE: Save the directory for later usage by # the test itself. # if {![info exists ::no(setVisualStudio)]} then { set ::test_visual_studio [file dirname $fileName] } } } } if {[llength $visualStudioVersions] > 0} then { # # NOTE: Show where we found the latest version. # tputs $channel [appendArgs "yes (" $visualStudioVersions ", \"" \ $::test_visual_studio "\")\n"] } else { tputs $channel no\n } } proc checkForNativeDebugger { channel } { tputs $channel "---- checking for native debugger... " # # NOTE: Is the native debugger present? # if {[catch {object invoke -flags +NonPublic \ Eagle._Components.Private.NativeOps+SafeNativeMethods \ IsDebuggerPresent} present] == 0 && $present} then { # # NOTE: Yes, it appears that it is present. # addConstraint nativeDebugger tputs $channel yes\n } else { tputs $channel no\n } } proc checkForManagedDebugger { channel } { tputs $channel "---- checking for managed debugger... " # # NOTE: Is the managed debugger attached? # if {[catch {object invoke System.Diagnostics.Debugger IsAttached} \ attached] == 0 && $attached} 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 \ getKnownCompileOptions getKnownMonoVersions lpermute \ alwaysFullInterpReady canExecTclShell canExecFossil \ checkForTestSuiteFiles checkForPlatform checkForWindowsVersion \ checkForScriptLibrary checkForVariable checkForTclOptions \ checkForWindowsCommandProcessor checkForFossil checkForEagle \ checkForSymbols checkForLogFile checkForGaruda checkForShell \ checkForDebug checkForTk checkForVersion checkForCommand \ checkForNamespaces checkForTestExec checkForTestMachine \ checkForTestPlatform checkForTestConfiguration checkForTestSuffix \ checkForFile checkForPathFile checkForNativeCode checkForTip127 \ checkForTip194 checkForTip207 checkForTip241 checkForTip285 \ checkForTip405 checkForTip426 checkForTip429 checkForTiming \ checkForPerformance checkForBigLists checkForMemoryIntensive \ checkForStackIntensive checkForInteractive checkForInteractiveCommand \ checkForUserInteraction checkForNetwork checkForCompileOption \ checkForKnownCompileOptions] false false ########################################################################### ############################## END Tcl ONLY ############################### ########################################################################### } # # NOTE: Provide the Eagle test constraints package to the interpreter. # package provide Eagle.Test.Constraints \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] }