Index: Externals/Eagle/bin/Eagle.dll ================================================================== --- Externals/Eagle/bin/Eagle.dll +++ Externals/Eagle/bin/Eagle.dll cannot compute difference between binary files Index: Externals/Eagle/bin/EagleShell.exe ================================================================== --- Externals/Eagle/bin/EagleShell.exe +++ Externals/Eagle/bin/EagleShell.exe cannot compute difference between binary files Index: Externals/Eagle/bin/x64/Spilornis.dll ================================================================== --- Externals/Eagle/bin/x64/Spilornis.dll +++ Externals/Eagle/bin/x64/Spilornis.dll cannot compute difference between binary files Index: Externals/Eagle/bin/x86/Spilornis.dll ================================================================== --- Externals/Eagle/bin/x86/Spilornis.dll +++ Externals/Eagle/bin/x86/Spilornis.dll cannot compute difference between binary files Index: Externals/Eagle/lib/Eagle1.0/init.eagle ================================================================== --- Externals/Eagle/lib/Eagle1.0/init.eagle +++ Externals/Eagle/lib/Eagle1.0/init.eagle @@ -1651,10 +1651,21 @@ return "" } return [expr {[$type IsValueType] ? 0 : "null"}] } + + proc getHostSize {} { + # + # NOTE: Attempt to query the size from the host; failing that, + # return a reasonable default value. + # + if {[catch {host size} result] == 0} then { + return $result + } + return [list 80 25]; # TODO: Good default? + } proc parray { a args } { if {[llength $args] > 2} then { error "wrong # args: should be \"parray a ?pattern?\"" } @@ -1675,11 +1686,11 @@ set maxLength $length } } set maxLength [expr {$maxLength + [string length $a] + 2}] - set hostLength [lindex [host size] 0] + set hostLength [lindex [getHostSize] 0] set valueLength [expr {$hostLength - $maxLength - 5}]; # " ... " foreach name $names { # # NOTE: Format the array element name for display. @@ -1723,11 +1734,11 @@ if {$length > $maxLength} { set maxLength $length } } - set hostLength [lindex [host size] 0] + set hostLength [lindex [getHostSize] 0] set valueLength [expr {$hostLength - $maxLength - 5}]; # " ... " foreach {name value} $d { # # NOTE: If the value by itself is too long to fit on one host line, Index: Externals/Eagle/lib/Eagle1.0/test.eagle ================================================================== --- Externals/Eagle/lib/Eagle1.0/test.eagle +++ Externals/Eagle/lib/Eagle1.0/test.eagle @@ -1340,19 +1340,19 @@ } return $result } - proc formatDecimal { value {places 4} } { + proc formatDecimal { value {places 4} {zeros false} } { if {[isEagle] && [llength [info commands object]] > 0} then { # # HACK: This works; however, in order to do this kind of thing cleanly, # we really need the Tcl [format] command. # set result [object invoke String Format [appendArgs "{0:0." \ - [string repeat # $places] "}"] [set object [object invoke \ - -create Double Parse $value]]] + [string repeat [expr {$zeros ? "0" : "#"}] $places] "}"] \ + [set object [object invoke -create Double Parse $value]]] unset object; # dispose } else { # # NOTE: See, nice and clean when done in Tcl? Index: Externals/Eagle/lib/Test1.0/constraints.eagle ================================================================== --- Externals/Eagle/lib/Test1.0/constraints.eagle +++ Externals/Eagle/lib/Test1.0/constraints.eagle @@ -28,10 +28,114 @@ 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]] } + + 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 { + set sha1 [hash normal sha1 [readFile $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. + # + 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 { @@ -1078,13 +1182,32 @@ # # NOTE: Are we allowed to do stack intensive testing? # if {![info exists ::no(stackIntensive)]} then { - addConstraint stackIntensive + 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 + tputs $channel yes\n + } else { + tputs $channel no\n + } + } else { + addConstraint stackIntensive + + tputs $channel yes\n + } } else { tputs $channel no\n } } @@ -1155,32 +1278,40 @@ tputs $channel [appendArgs \ "---- checking for network connectivity to host \"" $host "\"... "] if {[isEagle]} then { # - # BUGBUG: Tcl 8.4 does not like this expression (and Tcl tries to - # compile it even though it will only actually ever be - # evaluated in Eagle). - # - set expr {[llength [info commands uri]] > 0 && \ - [catch {uri ping $host $timeout} response] == 0 && \ - [lindex $response 0] in [list Success TimedOut] && \ - [string is integer -strict [lindex $response 1]] && \ - [lindex $response 1] <= $timeout} - - # - # NOTE: Does it look like we are able to contact the network host? - # - if {[expr $expr]} then { - # - # NOTE: Yes, it appears that it is available. - # - addConstraint [appendArgs network_ $host] - - tputs $channel [appendArgs "yes (" $response ")\n"] - } else { - tputs $channel no\n + # NOTE: Running this check on the Mono 3.3.0 release build will lock + # up the process; therefore, attempt to skip it in that case. + # + if {![isMono] || ![haveConstraint mono33]} 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, broken on Mono 3.3.0\n" } } else { # # HACK: Running in Tcl, just assume we have network access. # @@ -1708,17 +1839,17 @@ # # NOTE: What are the machine architecture and the # number of bits for this operating system? # if {[info exists ::tcl_platform(machine)] && \ - [info exists ::tcl_platform(osBits)]} then { + [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(osBits) eq $bits} then { + $::tcl_platform(processBits) eq $bits} then { # # NOTE: Yes, it matches. # addConstraint [appendArgs $machine . $bits bit] @@ -1725,12 +1856,12 @@ set result yes } else { set result no } - tputs $channel [appendArgs $result ", " $::tcl_platform(osBits) -bit \ - " " $::tcl_platform(machine) \n] + tputs $channel [appendArgs $result ", " $::tcl_platform(processBits) \ + -bit " " $::tcl_platform(machine) \n] } else { tputs $channel "no, unknown\n" } } @@ -2607,21 +2738,21 @@ # # NOTE: We need several of our test constraint related commands in the # global namespace. # exportAndImportPackageCommands [namespace current] [list \ - getKnownMonoVersions checkForPlatform checkForWindowsVersion \ - checkForScriptLibrary checkForVariable checkForTclOptions \ - checkForWindowsCommandProcessor checkForFossil checkForEagle \ - checkForSymbols checkForLogFile checkForGaruda checkForShell \ - checkForDebug checkForTk checkForVersion checkForCommand \ - checkForTestExec checkForTestMachine checkForTestPlatform \ - checkForTestConfiguration checkForTestSuffix checkForFile \ - checkForPathFile checkForNativeCode checkForTip127 checkForTip194 \ - checkForTip241 checkForTip285 checkForTip405 checkForTip426 \ - checkForTiming checkForPerformance checkForStackIntensive \ - checkForInteractive checkForInteractiveCommand \ + getKnownMonoVersions checkForTestSuiteFiles checkForPlatform \ + checkForWindowsVersion checkForScriptLibrary checkForVariable \ + checkForTclOptions checkForWindowsCommandProcessor checkForFossil \ + checkForEagle checkForSymbols checkForLogFile checkForGaruda \ + checkForShell checkForDebug checkForTk checkForVersion \ + checkForCommand checkForTestExec checkForTestMachine \ + checkForTestPlatform checkForTestConfiguration checkForTestSuffix \ + checkForFile checkForPathFile checkForNativeCode checkForTip127 \ + checkForTip194 checkForTip241 checkForTip285 checkForTip405 \ + checkForTip426 checkForTiming checkForPerformance \ + checkForStackIntensive checkForInteractive checkForInteractiveCommand \ checkForUserInteraction checkForNetwork checkForCompileOption] 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 @@ -119,21 +119,21 @@ # NOTE: Show the current state of the memory. # catch {debug memory} memory tputs $test_channel [appendArgs "---- ending memory: " \ - [formatListAsDict $memory] \n] + [formatListAsDict $memory ] \n] unset memory # # NOTE: Show the current state of the native stack. # catch {debug stack true} stack tputs $test_channel [appendArgs "---- ending stack: " \ - [formatListAsDict $stack] \n] + [formatListAsDict $stack ] \n] unset stack # # NOTE: Check for and display any duplicate test names that we found. In Index: Externals/Eagle/lib/Test1.0/prologue.eagle ================================================================== --- Externals/Eagle/lib/Test1.0/prologue.eagle +++ Externals/Eagle/lib/Test1.0/prologue.eagle @@ -590,29 +590,29 @@ unset encoding catch {host query} host tputs $test_channel [appendArgs "---- host query: " \ - [formatListAsDict $host] \n] + [formatListAsDict $host ] \n] unset host catch {debug memory} memory tputs $test_channel [appendArgs "---- starting memory: " \ - [formatListAsDict $memory] \n] + [formatListAsDict $memory ] \n] unset memory catch {debug stack true} stack tputs $test_channel [appendArgs "---- starting stack: " \ - [formatListAsDict $stack] \n] + [formatListAsDict $stack ] \n] unset stack catch {file drive} drive tputs $test_channel [appendArgs "---- system drive: " \ - [formatListAsDict $drive] \n] + [formatListAsDict $drive ] \n] unset drive } tputs $test_channel [appendArgs "---- executable: \"" \ @@ -1082,14 +1082,24 @@ # # NOTE: Has Windows support been enabled (at compile-time)? # if {![info exists no(compileWindows)]} then { # - # NOTE: For test "garuda-1.1". + # NOTE: For tests "garuda-1.1" and "garuda-1.2". # checkForCompileOption $test_channel WINDOWS } + + # + # NOTE: Has Windows Forms support been enabled (at compile-time)? + # + if {![info exists no(compileWinForms)]} then { + # + # NOTE: For tests "object-10.21", "tclLoad-1.2", "winForms-*.*". + # + checkForCompileOption $test_channel WINFORMS + } # # NOTE: Has native code support been enabled (at compile-time)? # if {![info exists no(compileNative)]} then { @@ -1102,11 +1112,11 @@ # # NOTE: Has native package support been enabled (at compile-time)? # if {![info exists no(compileNativePackage)]} then { # - # NOTE: For test "garuda-1.1". + # NOTE: For tests "garuda-1.1" and "garuda-1.2". # checkForCompileOption $test_channel NATIVE_PACKAGE } # @@ -1805,11 +1815,11 @@ # # NOTE: Has Garuda testing support been disabled? # if {![info exists no(garudaDll)]} then { # - # NOTE: For test "garuda-1.1". + # NOTE: For tests "garuda-1.1" and "garuda-1.2". # checkForGarudaDll $test_channel } ########################################################################### @@ -1865,10 +1875,17 @@ ####################### BEGIN Tcl & Eagle Constraints ####################### ############################################################################# tputs $test_channel [appendArgs \ "---- start of common (Tcl & Eagle) test constraints...\n"] + + # + # NOTE: Check for the test suite infrastructure files... + # + if {![info exists no(testSuiteFiles)]} then { + checkForTestSuiteFiles $test_channel + } # # NOTE: Has all use of [exec] for tests been disabled? # if {![info exists no(checkForTestExec)]} then { @@ -2476,11 +2493,11 @@ # # NOTE: Show the active test constraints. # tputs $test_channel [appendArgs "---- constraints: " \ - [formatList [lsort [getConstraints]]] \n] + [formatList [lsort [getConstraints]] ] \n] # # NOTE: Show the starting command count (for both Tcl and Eagle). # tputs $test_channel [appendArgs "---- starting command count: " \