Index: Externals/Eagle/lib/Eagle1.0/init.eagle ================================================================== --- Externals/Eagle/lib/Eagle1.0/init.eagle +++ Externals/Eagle/lib/Eagle1.0/init.eagle @@ -837,13 +837,16 @@ # accessor method. # set process [$array -alias GetValue $index] # - # NOTE: Add the Id of the process to the result list. + # NOTE: Add the Id of the process to the result list. This + # may fail on some versions of Mono. # - lappend result [$process Id] + if {[catch {$process Id} id] == 0} then { + lappend result $id + } # # NOTE: Get rid of the process object, we no longer need it. # Technically, it is not a requirement to explicitly # unset variables that contain object references; @@ -1239,15 +1242,44 @@ set command [list exec -shell -- \ [file join $directory Hippogriff.exe] -delay 2000] if {$automatic} then { - eval lappend command -silent true -confirm false + lappend command -silent true -confirm false + } + + set baseUri [getUpdateBaseUri] + + if {[string length $baseUri] > 0} then { + lappend command -baseUri $baseUri } eval $command &; exit -force } + + proc getUpdateBaseUri {} { + # + # NOTE: Check the current base URI for updates against the one baked + # into the assembly. If they are different, then the base URI + # must have been overridden. In that case, we must return the + # current base URI; otherwise, we must return an empty string. + # + set baseUri(0) [info engine UpdateBaseUri false]; # NOTE: Current. + set baseUri(1) [info engine UpdateBaseUri true]; # NOTE: Default. + + if {[string length $baseUri(0)] > 0 && \ + [string length $baseUri(1)] > 0} then { + # + # NOTE: Ok, they are both valid. Are they different? + # + if {$baseUri(0) ne $baseUri(1)} then { + return $baseUri(0) + } + } + + return "" + } proc getUpdateData { uri } { # # NOTE: Start trusting ONLY our own self-signed SSL certificate. # @@ -1311,14 +1343,19 @@ # proc checkForUpdate { {wantScripts false} {quiet false} {prompt false} {automatic false} } { # - # NOTE: This should work properly in Eagle only. + # NOTE: Grab the base URI for updates. + # + set updateBaseUri [info engine UpdateBaseUri] + + # + # NOTE: Append the path and query string used for updates to it. # set updateUri [appendArgs \ - [info engine UpdateBaseUri] [info engine UpdatePathAndQuery]] + $updateBaseUri [info engine UpdatePathAndQuery]] # # NOTE: Fetch the master update data from the distribution site # and normalize to Unix-style line-endings. # @@ -1425,18 +1462,26 @@ if {[string length $timeStamp] == 0} then { set timeStamp 0; #never? } + # + # NOTE: What should the DateTime format be for display? This + # should be some variation on ISO-8601. + # + set dateTimeFormat yyyy-MM-ddTHH:mm:ss + # # NOTE: Does it look like the number of seconds since the epoch # or some kind of date/time string? # if {[string is integer -strict $timeStamp]} then { - set dateTime [clock format $timeStamp] + set dateTime [clock format \ + $timeStamp -format $dateTimeFormat] } else { - set dateTime [clock format [clock scan $timeStamp]] + set dateTime [clock format \ + [clock scan $timeStamp] -format $dateTimeFormat] } # # NOTE: Grab the patch level for the running engine. # @@ -1454,13 +1499,15 @@ # # NOTE: Does it look like the number of seconds since the epoch # or some kind of date/time string? # if {[string is integer -strict $engineTimeStamp]} then { - set engineDateTime [clock format $engineTimeStamp] + set engineDateTime [clock format \ + $engineTimeStamp -format $dateTimeFormat] } else { - set engineDateTime [clock format [clock scan $engineTimeStamp]] + set engineDateTime [clock format \ + [clock scan $engineTimeStamp] -format $dateTimeFormat] } # # NOTE: For build lines, compare the patch level from the line # to the one we are currently using using a simple patch @@ -1534,11 +1581,12 @@ # if any, to upgrade now? # set text [appendArgs \ "latest build " $patchLevel ", dated " $dateTime \ ", is newer than the running build " $enginePatchLevel \ - ", dated " $engineDateTime] + ", dated " $engineDateTime ", based on data from " \ + $updateBaseUri] if {$prompt && [isInteractive]} then { set caption [appendArgs \ [info engine Name] " " [lindex [info level 0] 0]] @@ -1773,18 +1821,20 @@ # up-to-date than the latest version? # return [list [appendArgs \ "running build " $enginePatchLevel ", dated " \ $engineDateTime ", is newer than the latest build " \ - $patchLevel ", dated " $dateTime]] + $patchLevel ", dated " $dateTime ", based on data " \ + "from " $updateBaseUri]] } elseif {$checkBuild} then { # # NOTE: The patch levels are equal, we are up-to-date. # return [list [appendArgs \ "running build " $enginePatchLevel ", dated " \ - $engineDateTime ", is the latest build"]] + $engineDateTime ", is the latest build, based on " \ + "data from " $updateBaseUri]] } } } } } Index: Externals/Eagle/lib/Eagle1.0/test.eagle ================================================================== --- Externals/Eagle/lib/Eagle1.0/test.eagle +++ Externals/Eagle/lib/Eagle1.0/test.eagle @@ -485,12 +485,12 @@ # TODO: Add more support for standard tcltest options here. # set options [list \ -breakOnLeak -configuration -constraints -exitOnComplete -file \ -logFile -machine -match -no -notFile -platform -postTest -preTest \ - -randomOrder -skip -startFile -stopFile -stopOnFailure -stopOnLeak \ - -suffix -suite -tclsh -threshold] + -postWait -preWait -randomOrder -skip -startFile -stopFile \ + -stopOnFailure -stopOnLeak -suffix -suite -tclsh -threshold] set length [llength $args] for {set index 0} {$index < $length} {incr index} { # @@ -1972,17 +1972,51 @@ } else { set before $::tcltest::numTests(Failed) } # - # NOTE: Evaluate the file in the context of the caller, - # catching any errors. If an error is raised and the - # stop-on-failure flag is set, assume it was a test - # failure and that we need to stop any and all further - # processing of test files. + # NOTE: Evaluate the test file, optionally waiting for a certain + # number of milliseconds before and/or after doing so. # - if {[catch {uplevel 1 [list source $fileName]} error]} then { + if {[catch { + # + # NOTE: Are we being prevented from waiting before the file? + # + if {![info exists ::no(preWait)]} then { + if {[info exists ::test_wait(pre)] && \ + [string is integer -strict $::test_wait(pre)]} then { + tputs $channel [appendArgs \ + "---- waiting for " $::test_wait(pre) \ + " milliseconds before test file...\n"] + + after $::test_wait(pre); # NOTE: Sleep. + } + } + + # + # NOTE: Evaluate the file in the context of the caller, + # catching any errors. If an error is raised and the + # stop-on-failure flag is set, assume it was a test + # failure and that we need to stop any and all further + # processing of test files. + # + uplevel 1 [list source $fileName] + + # + # NOTE: Are we being prevented from waiting after the file? + # + if {![info exists ::no(postWait)]} then { + if {[info exists ::test_wait(post)] && \ + [string is integer -strict $::test_wait(post)]} then { + tputs $channel [appendArgs \ + "---- waiting for " $::test_wait(post) \ + " milliseconds after test file...\n"] + + after $::test_wait(post); # NOTE: Sleep. + } + } + } error]} then { # # NOTE: Most likely, this error was caused by malformed or # incorrect code in-between the tests themselves. We # need to report this. # @@ -2565,10 +2599,53 @@ return true; # already dead? } return false; # still alive (or error). } + + proc reportTestConstraintCounts { channel skippedNames } { + # + # NOTE: Process the list of skipped tests, which is really a dictionary + # of test names to the list of constraints that caused them to be + # skipped. We need to "roll them up", on a per-constraint basis, + # and produce counts for each constraint. At the same time, we + # need to keep track of the maximum count seen, to help align the + # final output. + # + set maximum 0 + + foreach {testName constraintNames} $skippedNames { + foreach constraintName $constraintNames { + if {[info exists skippedCounts($constraintName)]} then { + incr skippedCounts($constraintName) + } else { + set skippedCounts($constraintName) 1 + } + + if {$skippedCounts($constraintName) > $maximum} then { + set maximum $skippedCounts($constraintName) + } + } + } + + # + # NOTE: Produce the final output, which includes a single line header + # followed by one line per test constraint seen. + # + if {$maximum > 0 && [array size skippedCounts] > 0} then { + set places [expr {int(log10($maximum)) + 1}] + + tputs $channel "Number of tests skipped for each constraint:\n" + + foreach {name value} [array get skippedCounts] { + tputs $channel [appendArgs \ + \t [format [appendArgs % $places s] $value] \t $name \n] + } + + tputs $channel \n + } + } proc purgeAndCleanup { channel name } { catch {uplevel 1 [list debug purge]} result tputs $channel [appendArgs \ Index: Externals/Eagle/lib/Test1.0/constraints.eagle ================================================================== --- Externals/Eagle/lib/Test1.0/constraints.eagle +++ Externals/Eagle/lib/Test1.0/constraints.eagle @@ -41,12 +41,12 @@ 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] + THROW_ON_DISPOSED TRACE TYPE_CACHE UNIX USE_NAMESPACES VERBOSE WEB \ + WINDOWS WINFORMS WIX_30 WIX_35 WIX_36 WIX_37 WIX_38 WIX_39 X64 X86 XML] } proc getKnownMonoVersions {} { # # NOTE: This job of this procedure is to return the list of "known" @@ -53,11 +53,11 @@ # 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]] + [list 3 4] [list 3 5] [list 3 6] [list 3 8] [list 3 10] [list 3 12]] } # # 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 @@ -104,10 +104,31 @@ return [expr { [catch {interp readylimit {}} readylimit] != 0 || $readylimit == 0 }] } + # + # NOTE: This procedure should return non-zero if the "whoami" command may + # be executed by the test suite infrastructure outside the context + # of any specific tests. + # + proc canExecWhoAmI {} { + if {[info exists ::no(exec)]} then { + return false + } + + if {[info exists ::no(whoami)]} then { + return false + } + + if {[info exists ::no(canExecWhoAmI)]} then { + return false + } + + return true + } + # # 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 @@ -148,10 +169,113 @@ return false } return true } + + # + # NOTE: This procedure should return non-zero if the test suite should be + # considered to be running on Mono. + # + proc isTestMono {} { + return [expr {![info exists ::no(mono)] && [isMono]}] + } + + proc isTestAdministrator { {force false} } { + # + # NOTE: This is a workaround for the [isAdministrator] procedure being + # inaccurate for Mono on Windows, primarily due to the inability + # of Mono to call a P/Invoke method by ordinal. Also, this can + # be used for native Tcl on Windows. This only works on Windows. + # + if {[isWindows]} then { + # + # NOTE: Normally, this is only used for native Tcl or Eagle on Mono; + # however, it can be used for Eagle on the .NET Framework if + # forced. + # + if {$force || ![isEagle] || [isTestMono]} then { + if {[canExecWhoAmI] && \ + [catch {exec -- whoami /groups} groups] == 0} then { + set groups [string map [list \r\n \n] $groups] + + foreach group [split $groups \n] { + # + # NOTE: Match this group line against the "well-known" SID for + # the "Administrators" group on Windows. + # + if {[regexp -- {\sS-1-5-32-544\s} $group]} then { + # + # NOTE: Match this group line against the attributes column + # sub-value that should be present when running with + # elevated administrator credentials. + # + if {[regexp -- {\sEnabled group(?:,|\s)} $group]} then { + return true + } + } + } + } + } + } + + # + # NOTE: We must be running in native Tcl, running on Unix, running in + # Eagle on the .NET Framework, or unable to execute the "whoami" + # command. If running in Eagle, we can just fallback to using + # the [isAdministrator] procedure; otherwise, just return false. + # + return [expr {[isEagle] ? [isAdministrator] : false}] + } + + proc canPing { {varName ""} } { + # + # NOTE: If requested by the caller, provide a reason whenever false is + # returned from this procedure. + # + if {[string length $varName] > 0} then { + upvar 1 $varName reason + } + + # + # NOTE: Native Tcl (without extra packages) does not provide support for + # pinging a network host. + # + if {[isEagle]} then { + if {[isTestMono]} then { + # + # NOTE: Using [uri ping] on the Mono 3.3.0 (or 3.4.0?) release will + # lock up the process; therefore, skip it in that case. + # + if {[haveConstraint mono33] || [haveConstraint mono34]} then { + set reason "skipped, may hang on Mono 3.3.0 and 3.4.0" + return false + } + + # + # NOTE: Other versions of Mono, e.g. 3.12, appear to require elevated + # privileges (i.e. full administrator) in order to successfully + # execute [uri ping]. This has been verified on Windows. + # + if {![isTestAdministrator]} then { + set reason "skipped, need administrator privileges" + return false + } + } + + # + # NOTE: Eagle, when running on the Microsoft .NET Framework, supports + # pinging a network host as long as it was compiled with network + # support (which this procedure purposely does not check). That + # is done using [checkForCompileOption], by the test prologue. + # + return true + } + + set reason "skipped, need Eagle" + return false + } proc checkForTestSuiteFiles { channel } { tputs $channel "---- checking for test suite files... " # @@ -1429,12 +1553,11 @@ # # 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 { + if {![isTestMono] || ![haveConstraint nativeUtility]} then { # # NOTE: Yes, it appears that it is available. # addConstraint bigLists @@ -1449,10 +1572,25 @@ } } else { tputs $channel no\n } } + + proc checkForTimeIntensive { channel } { + tputs $channel "---- checking for time intensive testing... " + + # + # NOTE: Are we allowed to do time intensive testing? + # + if {![info exists ::no(timeIntensive)]} then { + addConstraint timeIntensive + + tputs $channel yes\n + } else { + tputs $channel no\n + } + } proc checkForMemoryIntensive { channel } { tputs $channel "---- checking for memory intensive testing... " # @@ -1571,12 +1709,13 @@ 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 { + set reason unknown + + if {[canPing reason]} 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). # @@ -1598,11 +1737,11 @@ 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" + tputs $channel [appendArgs $reason \n] } } else { # # HACK: Running in Tcl, just assume we have network access. # @@ -1815,21 +1954,32 @@ } proc checkForCertificate { channel } { tputs $channel "---- checking for certificate... " - if {[catch {object invoke Interpreter.GetActive GetCertificate} \ - certificate] == 0 && \ - [string length $certificate] > 0} then { + 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"] + # + # NOTE: Attempt to query the subject from the certificate. + # + if {[catch { + object invoke $certificate Subject + } subject] != 0 || [string length $subject] == 0} then { + # + # TODO: No certificate subject, better handling here? + # + set subject unknown + } + + tputs $channel [appendArgs "yes (" $subject ")\n"] } else { tputs $channel no\n } } @@ -1846,11 +1996,11 @@ } proc checkForAdministrator { channel } { tputs $channel "---- checking for administrator... " - if {[isAdministrator]} then { + if {[isTestAdministrator]} then { addConstraint administrator; # running as full admin. tputs $channel yes\n } else { tputs $channel no\n @@ -1917,20 +2067,31 @@ } 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 { + if {[catch { + object invoke AppDomain CurrentDomain + } appDomain] == 0 && [string length $appDomain] > 0} then { + if {[catch { + object invoke $appDomain IsDefaultAppDomain + } default] != 0 || [string length $default] == 0} then { + set default false + } + + if {[catch { + object invoke $appDomain Id + } id] != 0 || [string length $id] == 0} then { + set id unknown + } + + if {$default} then { addConstraint defaultAppDomain - tputs $channel [appendArgs "yes (" [object invoke $appDomain Id] \ - ")\n"] + tputs $channel [appendArgs "yes (" $id ")\n"] } else { - tputs $channel [appendArgs "no (" [object invoke $appDomain Id] \ - ")\n"] + tputs $channel [appendArgs "no (" $id ")\n"] } } else { tputs $channel [appendArgs "no (null)\n"] } } @@ -1939,11 +2100,11 @@ tputs $channel "---- checking for runtime... " # # NOTE: Are we running inside Mono (regardless of operating system)? # - if {![info exists ::no(mono)] && [isMono]} then { + if {[isTestMono]} then { # # NOTE: Yes, it appears that we are running inside Mono. # addConstraint mono; # running on Mono. @@ -2046,11 +2207,11 @@ # 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 { + if {[isTestMono]} then { # # NOTE: If the runtime version was found, add a test constraint # for it now. # if {[string length $version] > 0} then { @@ -2473,11 +2634,11 @@ # # 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 { + if {![isTestMono]} then { # # NOTE: Can we access the local database? # if {[catch {sql open -type $type $string} connection] == 0} then { # @@ -2967,10 +3128,70 @@ } } else { tputs $channel no\n } } + + proc checkForNetFx20ServicePack { channel } { + tputs $channel "---- checking for .NET Framework 2.0 Service Pack... " + + # + # 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 2.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\v2.0.50727}] + + # + # NOTE: Attempt to fetch the .NET Framework 2.0 "SP" value from the + # servicing registry hive. If this value does not exist -OR- + # is less than 1, then no .NET Framework 2.0 service pack is + # installed. If this raises a script error, that will almost + # certainly cause the result to be a non-integer, this failing + # the check below. + # + catch { + object invoke Microsoft.Win32.Registry GetValue $key SP null + } servicePack + + if {[string is integer -strict $servicePack]} then { + # + # NOTE: Service packs are always cumulative; therefore, add test + # constraints for all service pack levels up to the one that + # is actually installed. + # + for {set level 0} {$level <= $servicePack} {incr level} { + addConstraint [appendArgs dotNet20Sp $level OrHigher] + } + + # + # NOTE: Also add the "exact" service pack test constraint even + # though it should almost never be used. + # + addConstraint [appendArgs dotNet20Sp $servicePack] + + # + # NOTE: Show the "servicePack" value we found in the registry. + # + tputs $channel [appendArgs "yes (" $servicePack ")\n"] + + # + # NOTE: We are done here, return now. + # + return + } + } + + tputs $channel no\n + } proc checkForNetFx45 { channel } { tputs $channel "---- checking for .NET Framework 4.5... " # @@ -2989,26 +3210,38 @@ # # 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. + # installed. If this raises a script error, that will almost + # certainly cause the result to be a non-integer, this failing + # the check below. # - set release [object invoke Microsoft.Win32.Registry GetValue $key \ - Release null] + catch { + object invoke Microsoft.Win32.Registry GetValue $key Release null + } release 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. + # NOTE: If the "release" value is greater than or equal to 378758 + # (or 378675 for Windows 8.1), then the .NET Framework 4.5.1 + # is installed. However, if the "release" value is also + # greater than or equal to 379893, then the .NET Framework + # 4.5.2 is installed, which is an in-place upgrade to 4.5.1 + # (and 4.5). # - if {$release >= 378758} then { + if {$release >= 379893} then { + addConstraint dotNet452 + addConstraint dotNet452OrHigher + + set version 4.5.2 + } elseif {$release >= 378675} then { addConstraint dotNet451 addConstraint dotNet451OrHigher set version 4.5.1 } else { @@ -3230,25 +3463,25 @@ # 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 + alwaysFullInterpReady canExecWhoAmI canExecTclShell canExecFossil \ + isTestMono isTestAdministrator canPing 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 \ + checkForTimeIntensive checkForMemoryIntensive checkForStackIntensive \ + checkForInteractive checkForInteractiveCommand checkForUserInteraction \ + checkForNetwork checkForCompileOption checkForKnownCompileOptions] false false ########################################################################### ############################## END Tcl ONLY ############################### ########################################################################### } Index: Externals/Eagle/lib/Test1.0/epilogue.eagle ================================================================== --- Externals/Eagle/lib/Test1.0/epilogue.eagle +++ Externals/Eagle/lib/Test1.0/epilogue.eagle @@ -153,10 +153,11 @@ } unset -nocomplain name count tputs $test_channel \n; # NOTE: Blank line. + reportTestConstraintCounts $test_channel $eagle_tests(SkippedNames) if {$eagle_tests(Passed) > 0} then { tresult Ok [appendArgs "PASSED: " $eagle_tests(Passed) \n] } Index: Externals/Eagle/lib/Test1.0/prologue.eagle ================================================================== --- Externals/Eagle/lib/Test1.0/prologue.eagle +++ Externals/Eagle/lib/Test1.0/prologue.eagle @@ -20,12 +20,12 @@ } # # NOTE: Make sure all the variables used by this prologue are unset. # - unset -nocomplain pkg_dir pattern exec dummy directory name value expr \ - publicKeyToken encoding memory stack drive server database timeout \ + unset -nocomplain pkg_dir pattern dummy directory name value exec encoding \ + host memory stack drive publicKeyToken expr server database timeout \ user password percent checkout timeStamp loaded # # NOTE: Indicate that the test suite is currently running. # @@ -302,10 +302,12 @@ set test_flags(-stopOnFailure) ""; # default to continue on failure. set test_flags(-stopOnLeak) ""; # default to continue on leak. set test_flags(-exitOnComplete) ""; # default to not exit after complete. set test_flags(-preTest) ""; # default to not evaluating anything. set test_flags(-postTest) ""; # default to not evaluating anything. + set test_flags(-preWait) ""; # default to not waiting. + set test_flags(-postWait) ""; # default to not waiting. set test_flags(-tclsh) ""; # Tcl shell, default to empty. # # NOTE: Check for and process any command line arguments. # @@ -401,10 +403,26 @@ # # NOTE: Set the pre-test script to the one provided by the command line. # set test_script(post) $test_flags(-postTest) } + + if {[info exists test_flags(-preWait)] && \ + [string is integer -strict $test_flags(-preWait)]} then { + # + # NOTE: Set the specified wait (in milliseconds) before each file. + # + set test_wait(pre) $test_flags(-preWait) + } + + if {[info exists test_flags(-postWait)] && \ + [string is integer -strict $test_flags(-postWait)]} then { + # + # NOTE: Set the specified wait (in milliseconds) after each file. + # + set test_wait(post) $test_flags(-postWait) + } } # # NOTE: Set the default test suite name, if necessary. # @@ -555,10 +573,26 @@ tputs $test_channel [appendArgs "---- post-test script: " \ [expr {[info exists test_script(post)] && \ [string length $test_script(post)] > 0 ? \ [appendArgs \" $test_script(post) \"] : ""}] \n] + # + # NOTE: Show both the pre-test and post-test waits now, prior to actually + # using either of them (even if their use has been disabled). + # + tputs $test_channel [appendArgs "---- pre-test wait: " \ + [expr {[info exists test_wait(pre)] && \ + [string is integer -strict $test_wait(pre)] ? \ + [appendArgs $test_wait(pre) " milliseconds"] : \ + ""}] \n] + + tputs $test_channel [appendArgs "---- post-test wait: " \ + [expr {[info exists test_wait(post)] && \ + [string is integer -strict $test_wait(post)] ? \ + [appendArgs $test_wait(post) " milliseconds"] : \ + ""}] \n] + # # NOTE: Are we being prevented from evaluating the "pre-test" script? # if {![info exists no(preTest)]} then { # @@ -808,11 +842,11 @@ # NOTE: If the "no(mono)" variable is set (to anything) then any # special test suite hacks for Mono will be disabled. This # does not control or change any hacks for Mono that may # be present in the library itself. # - # if {![info exists no(mono)] && [isMono]} then { + # if {[isTestMono]} then { # set no(mono) true # } ########################################################################### ######################### BEGIN Eagle Constraints ######################### @@ -1474,10 +1508,24 @@ # # NOTE: Has custom test method support been disabled? # if {![info exists no(core)] && ![info exists no(test)]} then { + # + # NOTE: Has plugin policy testing support been disabled? + # + if {![info exists no(testPluginPolicy)]} then { + # + # NOTE: For tests "load-2.0" and "load-2.1". + # + checkForObjectMember $test_channel Eagle._Tests.Default \ + *TestAddLoadPluginPolicy* + + checkForObjectMember $test_channel Eagle._Tests.Default \ + *TestLoadPluginPolicy* + } + # # NOTE: Has script stream testing support been disabled? # if {![info exists no(testScriptStream)]} then { # @@ -1484,18 +1532,43 @@ # NOTE: For tests "basic-1.46" and "basic-1.47". # checkForObjectMember $test_channel Eagle._Tests.Default \ *TestScriptStream* } + + # + # NOTE: Has complaint testing support been disabled? + # + if {![info exists no(testComplain)]} then { + # + # NOTE: For tests "debug-1.98" and "debug-1.99". + # + checkForObjectMember $test_channel Eagle._Tests.Default \ + *TestSetComplainCallback* + + checkForObjectMember $test_channel Eagle._Tests.Default \ + *TestComplainCallbackThrow* + + checkForObjectMember $test_channel Eagle._Tests.Default \ + *TestComplainCallbackNoThrow* + } if {![info exists no(testLoad)]} then { # # NOTE: For tests "load-1.6" and "load-1.7". # checkForObjectMember $test_channel Eagle._Tests.Default \ *TestLoadPluginViaBytes* } + + if {![info exists no(testPermute)]} then { + # + # NOTE: For test "lpermute-1.3". + # + checkForObjectMember $test_channel Eagle._Tests.Default \ + *TestPermute* + } # # NOTE: Has DateTime testing support been disabled? # if {![info exists no(testDateTime)]} then { @@ -1786,10 +1859,23 @@ # NOTE: For test "object-4.1". # checkForObjectMember $test_channel Eagle._Tests.Default \ *TestExpr* + # + # NOTE: For tests "basic-1.66", "basic-1.67", "basic-1.68", + # and "basic-1.69". + # + checkForObjectMember $test_channel Eagle._Tests.Default \ + *TestTakeEventHandler* + + checkForObjectMember $test_channel Eagle._Tests.Default \ + *TestTakeGenericEventHandler* + + checkForObjectMember $test_channel Eagle._Tests.Default \ + *TestTakeResolveEventHandler* + # # NOTE: For test "array-4.1". # checkForObjectMember $test_channel Eagle._Tests.Default \ *TestTwoByteArrays* @@ -1963,10 +2049,21 @@ # # NOTE: For tests "object-4.7", "object-4.8", and "object-4.9". # checkForPowerShell $test_channel } + + # + # NOTE: Has .NET Framework 2.0 Service Pack testing support been + # disabled? + # + if {![info exists no(netFx20Sp)]} then { + # + # NOTE: For test "hash-1.1". + # + checkForNetFx20ServicePack $test_channel + } # # NOTE: Has .NET Framework 4.5 testing support been disabled? # if {![info exists no(netFx45)]} then { @@ -2465,10 +2562,14 @@ } if {![info exists no(checkForBigLists)]} then { checkForBigLists $test_channel } + + if {![info exists no(checkForTimeIntensive)]} then { + checkForTimeIntensive $test_channel + } if {![info exists no(checkForMemoryIntensive)]} then { checkForMemoryIntensive $test_channel }