Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Update Eagle script library in externals to the latest trunk code. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
85b231175b9418a9f8d1f01f44a64835 |
| User & Date: | mistachkin 2015-04-08 21:36:55 |
Context
|
2015-04-08
| ||
| 22:03 | Modify test suite initialization to work without the 'object' command, if necessary. check-in: 179f0629be user: mistachkin tags: trunk | |
| 21:36 | Update Eagle script library in externals to the latest trunk code. check-in: 85b231175b user: mistachkin tags: trunk | |
| 18:30 | Update the included core library documentation. check-in: ba3097cbdb user: mistachkin tags: trunk | |
Changes
Changes to Externals/Eagle/lib/Eagle1.0/init.eagle.
136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 ... 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 ... 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 ... 911 912 913 914 915 916 917 918 919 920 921 922 923 924 .... 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 .... 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 .... 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 .... 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 .... 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 .... 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 .... 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 .... 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 .... 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 |
proc getEnvironmentVariable { name } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
return [expr {[info exists ::env($name)] ? $::env($name) : ""}]
}
proc combineFlags { flags1 flags2 } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
set result [list]
foreach flags [list $flags1 $flags2] {
foreach flag [split $flags ", "] {
set flag [string trim $flag]
if {[string length $flag] > 0} then {
lappend result $flag
}
}
}
return [join $result ,]
}
................................................................................
$::eagle_platform(administrator)}]
}
proc hasRuntimeOption { name } {
#
# NOTE: Returns non-zero if the specified runtime option is set.
#
return [object invoke Interpreter.GetActive HasRuntimeOption $name]
}
proc getPluginFlags { pattern } {
foreach loaded [info loaded] {
set plugin [lindex $loaded end]
if {[regexp -- $pattern $plugin]} then {
................................................................................
proc getProcesses { name } {
#
# NOTE: Start with an empty list of process Ids.
#
set result [list]
#
# NOTE: Does the caller want processes matching a specific name
# or all processes on the local machine?
#
if {[string length $name] > 0} then {
#
# NOTE: Get the managed array of processes with matching names.
#
set array [object invoke -alias System.Diagnostics.Process \
GetProcessesByName $name]
} else {
#
# NOTE: Get the managed array of all processes on the local
# machine.
#
set array [object invoke -alias System.Diagnostics.Process \
GetProcesses]
}
#
# NOTE: For each process in the resulting array, grab the Id.
#
for {set index 0} {$index < [$array Length]} {incr index} {
#
................................................................................
}
#
# NOTE: This proc can be used to dynamically compile C# code in a script.
#
proc compileCSharp {
string memory symbols strict resultsVarName errorsVarName args } {
#
# NOTE: Create the C# code provider object (i.e. the compiler).
#
set provider [object create -alias Microsoft.CSharp.CSharpCodeProvider]
#
# NOTE: Create the object that provides various parameters to the C#
................................................................................
}
#
# NOTE: Prepare to transfer the object reference to the caller. We
# must use upvar here because otherwise the object is lost when
# the procedure call frame is cleaned up.
#
upvar 1 $resultsVarName results
#
# NOTE: Attempt to compile the specified string as C# and capture the
# results into the variable provided by the caller.
#
set results [$provider -alias CompileAssemblyFromSource $parameters \
$string]
................................................................................
if {[$errors HasErrors] || ($strict && [$errors HasWarnings])} then {
#
# NOTE: Compilation of the assembly failed.
#
set code Error
#
# NOTE: Prepare to transfer the error messages to the caller.
#
upvar 1 $errorsVarName local_errors
#
# NOTE: How many compile errors?
#
set count [$errors Count]
#
................................................................................
#
# NOTE: We no longer need the collection of compiler errors;
# therefore, dispose it now.
#
unset errors; # dispose
return $code
}
proc matchEnginePublicKeyToken { publicKeyToken } {
return [expr {[string length $publicKeyToken] == 0 || \
$publicKeyToken eq [info engine PublicKeyToken]}]
}
................................................................................
set text [appendArgs \
"latest build " $patchLevel ", dated " $dateTime \
", is newer than the running build " $enginePatchLevel \
", dated " $engineDateTime ", based on data from " \
$updateBaseUri]
if {$prompt && [isInteractive]} then {
set caption [appendArgs \
[info engine Name] " " [lindex [info level 0] 0]]
if {[object invoke -flags +NonPublic \
Eagle._Components.Private.WindowOps YesOrNo \
[appendArgs $text \n\n "Run the updater now?"] \
$caption false]} then {
#
# NOTE: Ok, run the updater now and then exit.
#
runUpdateAndExit $automatic
}
}
return [list $text [list $baseUri $patchLevel] [list $notes]]
}
#
................................................................................
} else {
return [list \
"could not determine if running build is the latest build"]
}
}
proc getReturnType { object member } {
if {[string length $object] == 0 || [string length $member] == 0} then {
return ""
}
set code [catch {
object foreach -alias memberInfo \
[object invoke -noinvoke $object $member] {
#
................................................................................
# NOTE: If no error was raised above, return the result; otherwise,
# return an empty string to indicate a general failure.
#
return [expr {$code == 2 ? $result : ""}]
}
proc getDefaultValue { typeName } {
if {[string length $typeName] == 0} then {
return ""
}
set type [object invoke -create -alias Type GetType $typeName]
if {[string length $type] == 0} then {
................................................................................
#
# 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?\""
}
................................................................................
# HACK: Mono does not currently support calling the String.Format
# overload that takes a variable number of arguments via
# reflection (Mono bug #636939).
#
if {![isMono]} then {
set line [string format -verbatim -- [appendArgs "\{0,-" \
$maxLength "\} = {1}"] $nameString $valueString]
} else {
set line [object invoke String Format [appendArgs "\{0,-" \
$maxLength "\} = {1}"] $nameString $valueString]
}
puts stdout $line
}
}
proc pdict { d } {
................................................................................
#
# HACK: Mono does not currently support calling the String.Format
# overload that takes a variable number of arguments via
# reflection (Mono bug #636939).
#
if {![isMono]} then {
set line [string format -verbatim -- "{0,-$maxLength} = {1}" \
$name $valueString]
} else {
set line [object invoke String Format "{0,-$maxLength} = {1}" \
$name $valueString]
}
puts stdout $line
}
}
|
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > | > > > > > > > > > | | | | | | | | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | > | > > > > > > > > > | | | | | | | | | | > > > > > | > > > > > | > > > | | > > > < > |
136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 ... 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 ... 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 ... 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 .... 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 .... 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 .... 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 .... 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 .... 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 .... 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 .... 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 .... 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 .... 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 |
proc getEnvironmentVariable { name } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
return [expr {[info exists ::env($name)] ? $::env($name) : ""}]
}
proc combineFlags { flags1 flags2 {flags3 ""} {noCase false} } {
#
# NOTE: This should work properly in both Tcl and Eagle.
#
set result [list]
set notFlags [list]
if {[string length $flags3] > 0} then {
foreach flag [split $flags3 ", "] {
set flag [string trim $flag]
if {[string length $flag] > 0} then {
lappend notFlags $flag
}
}
}
foreach flags [list $flags1 $flags2] {
foreach flag [split $flags ", "] {
set flag [string trim $flag]
if {[string length $flag] > 0} then {
set addFlag false
if {[llength $notFlags] > 0} then {
set command [list lsearch -exact]
if {$noCase} then {
lappend command -nocase
}
lappend command -- $notFlags $flag
if {[eval $command] == -1} then {
set addFlag true
}
} else {
set addFlag true
}
if {$addFlag} then {
lappend result $flag
}
}
}
}
return [join $result ,]
}
................................................................................
$::eagle_platform(administrator)}]
}
proc hasRuntimeOption { name } {
#
# NOTE: Returns non-zero if the specified runtime option is set.
#
if {[catch {
object invoke Interpreter.GetActive HasRuntimeOption $name
} result] == 0} then {
return $result
} else {
return false
}
}
proc getPluginFlags { pattern } {
foreach loaded [info loaded] {
set plugin [lindex $loaded end]
if {[regexp -- $pattern $plugin]} then {
................................................................................
proc getProcesses { name } {
#
# NOTE: Start with an empty list of process Ids.
#
set result [list]
#
# NOTE: Are we able to actually query the active processes?
#
if {[llength [info commands object]] > 0} then {
#
# NOTE: Does the caller want processes matching a specific name
# or all processes on the local machine?
#
if {[string length $name] > 0} then {
#
# NOTE: Get the managed array of processes with matching names.
#
set array [object invoke -alias System.Diagnostics.Process \
GetProcessesByName $name]
} else {
#
# NOTE: Get the managed array of all processes on the local
# machine.
#
set array [object invoke -alias System.Diagnostics.Process \
GetProcesses]
}
} else {
#
# NOTE: No, return nothing.
#
return $result
}
#
# NOTE: For each process in the resulting array, grab the Id.
#
for {set index 0} {$index < [$array Length]} {incr index} {
#
................................................................................
}
#
# NOTE: This proc can be used to dynamically compile C# code in a script.
#
proc compileCSharp {
string memory symbols strict resultsVarName errorsVarName args } {
#
# NOTE: The [object] command is required by this procedure. If it
# is not available, bail out now.
#
if {[llength [info commands object]] == 0} then {
#
# NOTE: We cannot even attempt to compile anything, fail.
#
set code Error
#
# NOTE: Prepare to transfer error messages to the caller.
#
if {[string length $errorsVarName] > 0} then {
upvar 1 $errorsVarName local_errors
}
#
# NOTE: Append to the list of errors.
#
lappend local_errors "cannot compile, missing \"object\" command"
#
# NOTE: Return the overall result to the caller.
#
return $code
}
#
# NOTE: Create the C# code provider object (i.e. the compiler).
#
set provider [object create -alias Microsoft.CSharp.CSharpCodeProvider]
#
# NOTE: Create the object that provides various parameters to the C#
................................................................................
}
#
# NOTE: Prepare to transfer the object reference to the caller. We
# must use upvar here because otherwise the object is lost when
# the procedure call frame is cleaned up.
#
if {[string length $resultsVarName] > 0} then {
upvar 1 $resultsVarName results
}
#
# NOTE: Attempt to compile the specified string as C# and capture the
# results into the variable provided by the caller.
#
set results [$provider -alias CompileAssemblyFromSource $parameters \
$string]
................................................................................
if {[$errors HasErrors] || ($strict && [$errors HasWarnings])} then {
#
# NOTE: Compilation of the assembly failed.
#
set code Error
#
# NOTE: Prepare to transfer error messages to the caller.
#
if {[string length $errorsVarName] > 0} then {
upvar 1 $errorsVarName local_errors
}
#
# NOTE: How many compile errors?
#
set count [$errors Count]
#
................................................................................
#
# NOTE: We no longer need the collection of compiler errors;
# therefore, dispose it now.
#
unset errors; # dispose
#
# NOTE: Return the overall result to the caller.
#
return $code
}
proc matchEnginePublicKeyToken { publicKeyToken } {
return [expr {[string length $publicKeyToken] == 0 || \
$publicKeyToken eq [info engine PublicKeyToken]}]
}
................................................................................
set text [appendArgs \
"latest build " $patchLevel ", dated " $dateTime \
", is newer than the running build " $enginePatchLevel \
", dated " $engineDateTime ", based on data from " \
$updateBaseUri]
if {$prompt && [isInteractive]} then {
#
# NOTE: Is the [object] command available? If not,
# this cannot be done.
#
if {[llength [info commands object]] > 0} then {
set caption [appendArgs \
[info engine Name] " " [lindex [info level 0] 0]]
if {[object invoke -flags +NonPublic \
Eagle._Components.Private.WindowOps YesOrNo \
[appendArgs $text \n\n "Run the updater now?"] \
$caption false]} then {
#
# NOTE: Ok, run the updater now and then exit.
#
runUpdateAndExit $automatic
}
}
}
return [list $text [list $baseUri $patchLevel] [list $notes]]
}
#
................................................................................
} else {
return [list \
"could not determine if running build is the latest build"]
}
}
proc getReturnType { object member } {
if {[string length $object] == 0} then {
return ""
}
if {[string length $member] == 0} then {
return ""
}
set code [catch {
object foreach -alias memberInfo \
[object invoke -noinvoke $object $member] {
#
................................................................................
# NOTE: If no error was raised above, return the result; otherwise,
# return an empty string to indicate a general failure.
#
return [expr {$code == 2 ? $result : ""}]
}
proc getDefaultValue { typeName } {
if {[llength [info commands object]] == 0} then {
return ""
}
if {[string length $typeName] == 0} then {
return ""
}
set type [object invoke -create -alias Type GetType $typeName]
if {[string length $type] == 0} then {
................................................................................
#
# 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?\""
}
................................................................................
# HACK: Mono does not currently support calling the String.Format
# overload that takes a variable number of arguments via
# reflection (Mono bug #636939).
#
if {![isMono]} then {
set line [string format -verbatim -- [appendArgs "\{0,-" \
$maxLength "\} = {1}"] $nameString $valueString]
} elseif {[llength [info commands object]] > 0} then {
set line [object invoke String Format [appendArgs "\{0,-" \
$maxLength "\} = {1}"] $nameString $valueString]
} else {
set line [format [appendArgs "%-" $maxLength "s = %s"] \
$nameString $valueString]
}
puts stdout $line
}
}
proc pdict { d } {
................................................................................
#
# HACK: Mono does not currently support calling the String.Format
# overload that takes a variable number of arguments via
# reflection (Mono bug #636939).
#
if {![isMono]} then {
set line [string format -verbatim -- [appendArgs "\{0,-" \
$maxLength "\} = {1}"] $name $valueString]
} elseif {[llength [info commands object]] > 0} then {
set line [object invoke String Format [appendArgs "\{0,-" \
$maxLength "\} = {1}"] $name $valueString]
} else {
set line [format [appendArgs "%-" $maxLength "s = %s"] \
$name $valueString]
}
puts stdout $line
}
}
|
Changes to Externals/Eagle/lib/Eagle1.0/test.eagle.
421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 .... 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 .... 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 .... 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 |
return [clock format $seconds -gmt $gmt -iso -isotimezone]
} else {
return [clock format $seconds -gmt $gmt -format "%Y-%m-%dT%H:%M:%S %Z"]
}
}
proc formatElapsedTime { seconds } {
if {[isEagle]} then {
#
# NOTE: Create a TimeSpan instance based on the number of whole
# seconds.
#
set timeSpan [object invoke -create -alias TimeSpan FromSeconds \
$seconds]
................................................................................
proc recordTestStatistics { varName index } {
#
# NOTE: Record counts of all object types that we track.
#
upvar 1 $varName array
set array(uncounted,$index) [list]
set array(time,$index) [clock seconds]
set array(afters,$index) [llength [after info]]
set array(variables,$index) [llength [info globals]]
set array(commands,$index) [llength [info commands]]
set array(procedures,$index) [llength [info procs]]
set array(namespaces,$index) [llength [namespace children ::]]
................................................................................
set array(files,$index) [llength [getFiles $::test_path *]]
set array(temporaryFiles,$index) [llength [getFiles [getTemporaryPath] *]]
set array(channels,$index) [llength [file channels]]
set array(aliases,$index) [llength [interp aliases]]
set array(interpreters,$index) [llength [interp slaves]]
set array(environment,$index) [llength [array names env]]
#
# NOTE: These native resource types cannot be positively checked
# for leaks (i.e. because the "leak" may be from an external
# process).
#
lappend array(uncounted,$index) temporaryFiles
if {[isEagle]} then {
set array(scopes,$index) [llength [scope list]]
set array(assemblies,$index) [llength [object assemblies]]
set array(processes,$index) [llength [getProcesses ""]]
set array(objects,$index) [llength [info objects]]
set array(objectCallbacks,$index) [llength [info callbacks]]
set array(objectTypes,$index) [llength [object types]]
set array(objectInterfaces,$index) [llength [object interfaces]]
set array(objectNamespaces,$index) [llength [object namespaces]]
#
# NOTE: These managed resource types cannot be positively checked
# for leaks (i.e. because the "leak" may be from an external
# process).
#
lappend array(uncounted,$index) assemblies processes
#
# NOTE: Support for some of all of these entity types may not be
# present in the interpreter, initialize all these counts
# to zero and then try to query each one individually below
# wrapped in a catch.
#
................................................................................
catch {set array(connections,$index) [llength [info connections]]}
catch {set array(transactions,$index) [llength [info transactions]]}
catch {set array(modules,$index) [llength [info modules]]}
catch {set array(delegates,$index) [llength [info delegates]]}
if {[llength [info commands tcl]] > 0} then {
set array(tcl,$index) [tcl ready]
}
catch {set array(tclInterps,$index) [llength [tcl interps]]}
catch {set array(tclThreads,$index) [llength [tcl threads]]}
catch {set array(tclCommands,$index) [llength [tcl command list]]}
#
# NOTE: Grab the number of active threads that are active because
# of ScriptThread object instances. This only works if Eagle
# is Beta 31 or higher.
#
catch {
set array(scriptThreads,$index) [object invoke -flags +NonPublic \
ScriptThread activeCount]
}
}
}
proc reportTestStatistics { channel fileName statsVarName filesVarName } {
set statistics [list afters variables commands procedures namespaces \
files temporaryFiles channels aliases interpreters environment]
|
| > > > > > > > > > > > > > > > > > > > > > | | | | | | | | < < < < < < > | | | > > > > > > > > > |
421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 .... 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 .... 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 .... 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 |
return [clock format $seconds -gmt $gmt -iso -isotimezone]
} else {
return [clock format $seconds -gmt $gmt -format "%Y-%m-%dT%H:%M:%S %Z"]
}
}
proc formatElapsedTime { seconds } {
if {[isEagle] && [llength [info commands object]] > 0} then {
#
# NOTE: Create a TimeSpan instance based on the number of whole
# seconds.
#
set timeSpan [object invoke -create -alias TimeSpan FromSeconds \
$seconds]
................................................................................
proc recordTestStatistics { varName index } {
#
# NOTE: Record counts of all object types that we track.
#
upvar 1 $varName array
###########################################################################
set array(uncounted,$index) [list]
set array(time,$index) [clock seconds]
set array(afters,$index) [llength [after info]]
set array(variables,$index) [llength [info globals]]
set array(commands,$index) [llength [info commands]]
set array(procedures,$index) [llength [info procs]]
set array(namespaces,$index) [llength [namespace children ::]]
................................................................................
set array(files,$index) [llength [getFiles $::test_path *]]
set array(temporaryFiles,$index) [llength [getFiles [getTemporaryPath] *]]
set array(channels,$index) [llength [file channels]]
set array(aliases,$index) [llength [interp aliases]]
set array(interpreters,$index) [llength [interp slaves]]
set array(environment,$index) [llength [array names env]]
###########################################################################
#
# NOTE: These native resource types cannot be positively checked
# for leaks (i.e. because the "leak" may be from an external
# process).
#
lappend array(uncounted,$index) temporaryFiles
###########################################################################
if {[isEagle]} then {
#
# NOTE: Support for some of all of these entity types may not be
# present in the interpreter, initialize all these counts
# to zero and then try to query each one individually below
# wrapped in a catch.
#
set array(scopes,$index) 0
set array(assemblies,$index) 0
set array(processes,$index) 0
set array(objects,$index) 0
set array(objectCallbacks,$index) 0
set array(objectTypes,$index) 0
set array(objectInterfaces,$index) 0
set array(objectNamespaces,$index) 0
catch {set array(scopes,$index) [llength [scope list]]}
catch {set array(assemblies,$index) [llength [object assemblies]]}
catch {set array(processes,$index) [llength [getProcesses ""]]}
catch {set array(objects,$index) [llength [info objects]]}
catch {set array(objectCallbacks,$index) [llength [info callbacks]]}
catch {set array(objectTypes,$index) [llength [object types]]}
catch {set array(objectInterfaces,$index) [llength [object interfaces]]}
catch {set array(objectNamespaces,$index) [llength [object namespaces]]}
#########################################################################
#
# NOTE: Support for some of all of these entity types may not be
# present in the interpreter, initialize all these counts
# to zero and then try to query each one individually below
# wrapped in a catch.
#
................................................................................
catch {set array(connections,$index) [llength [info connections]]}
catch {set array(transactions,$index) [llength [info transactions]]}
catch {set array(modules,$index) [llength [info modules]]}
catch {set array(delegates,$index) [llength [info delegates]]}
if {[llength [info commands tcl]] > 0} then {
catch {set array(tcl,$index) [tcl ready]}
}
catch {set array(tclInterps,$index) [llength [tcl interps]]}
catch {set array(tclThreads,$index) [llength [tcl threads]]}
catch {set array(tclCommands,$index) [llength [tcl command list]]}
#
# NOTE: Grab the number of active threads that are active because
# of ScriptThread object instances. This only works if Eagle
# is Beta 31 or higher.
#
catch {
set array(scriptThreads,$index) \
[object invoke -flags +NonPublic ScriptThread activeCount]
}
#########################################################################
#
# NOTE: These managed resource types cannot be positively checked
# for leaks (i.e. because the "leak" may be from an external
# process).
#
lappend array(uncounted,$index) assemblies processes
}
}
proc reportTestStatistics { channel fileName statsVarName filesVarName } {
set statistics [list afters variables commands procedures namespaces \
files temporaryFiles channels aliases interpreters environment]
|
Changes to Externals/Eagle/lib/Test1.0/constraints.eagle.
26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 .... 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 .... 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 .... 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 .... 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 .... 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 .... 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 |
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 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"
# versions of Mono supported by the test suite infrastructure.
#
................................................................................
}
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
................................................................................
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 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 *?]]
................................................................................
} 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).
#
................................................................................
#
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
................................................................................
#
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
|
| | | | | | | | | > | | | | | | > | < < < > > < < | | | | | | | | | | | | | | | | | | | | | | | | | | < < < | < < | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | |
26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 .... 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 .... 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 .... 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 .... 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 .... 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 .... 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 |
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 EMBED_CERTIFICATE 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_THREAD_ID \
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 OBFUSCATION OFFICIAL PARSE_CACHE PATCHLEVEL \
PLUGIN_COMMANDS POLICY_TRACE PREVIOUS_RESULT RANDOMIZE_ID REMOTING \
SAMPLE SECURITY 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 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"
# versions of Mono supported by the test suite infrastructure.
#
................................................................................
}
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).
#
if {[catch {namespace enable} enabled] == 0} then {
set available true
addConstraint namespaces.available
} else {
set available false
addConstraint namespaces.unavailable
}
#
# 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 {
#
# NOTE: All supported versions of native Tcl have namespaces enabled
# and available.
#
addConstraint namespaces.available
................................................................................
tputs $channel error\n
}
}
proc checkForPrimaryThread { channel } {
tputs $channel "---- checking for primary thread... "
if {[info tid] == [set threadId [info ptid]]} then {
addConstraint primaryThread
tputs $channel [appendArgs "yes (" $threadId ")\n"]
} else {
tputs $channel [appendArgs "no (" $threadId ")\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 *?]]
................................................................................
} elseif {[haveConstraint tclLibrary84]} then {
addConstraint tclReadyOrLibrary84
}
tputs $channel no\n
}
}
proc checkForTclSelect { channel } {
tputs $channel "---- checking for Tcl library selection... "
if {[catch {tcl select -architecture} select] == 0} then {
#
# NOTE: Yes, native Tcl is "probably loadable".
#
addConstraint tclSelect
#
# NOTE: Ok, attempt to determine the selected Tcl version.
#
if {[catch {
getDictionaryValue $select version
} version] == 0 && [regexp -- {^\d+\.\d+$} $version]} then {
addConstraint [appendArgs \
tclSelect [string map [list . ""] $version]]
tputs $channel [appendArgs "yes (" $select ")\n"]
} else {
#
# NOTE: The Tcl library is "probably loadable"; however, we have
# no idea what version it actually is.
#
tputs $channel yes\n
}
} else {
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).
#
................................................................................
#
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 {
catch {object flags $debugger +NoDispose}
}
if {[regexp -- {^Debugger#\d+$} $debugger]} then {
#
# NOTE: Yes, it appears that it is available.
#
addConstraint scriptDebugger
................................................................................
#
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 {
catch {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 {
catch {object flags $interp +NoDispose}
}
if {[regexp -- {^Interpreter#\d+$} $interp]} then {
#
# NOTE: Yes, it appears that it is available.
#
addConstraint scriptDebuggerInterpreter
|
Changes to Externals/Eagle/lib/Test1.0/epilogue.eagle.
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
...
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
#
# NOTE: Verify that the current call frame is correct and that the
# interpreter call stack has not been imbalanced by previous
# tests or other errors. This check only applies to Eagle.
#
if {[isEagle]} then {
#
# NOTE: Check the name of the current call frame against the one
# that should be used for evaluating this script file.
#
if {[object invoke -flags +NonPublic \
Interpreter.GetActive.CurrentFrame Name] ne \
[list source [file normalize [info script]]]} then {
unset -nocomplain test_suite_running
error "cannot run, current frame is not for this script"
}
}
#
# NOTE: Make sure all the variables used by this epilogue are unset.
#
unset -nocomplain memory stack name count passedOrSkipped percent \
................................................................................
" microseconds\n"]
}
}
#
# NOTE: Show the ending operation count (for Eagle only).
#
tputs $test_channel [appendArgs "---- ending operation count: " \
[object invoke -flags +NonPublic Interpreter.GetActive \
OperationCount] \n]
#
# NOTE: Show the current state of the memory.
#
catch {debug memory} memory
tputs $test_channel [appendArgs "---- ending memory: " \
|
>
|
|
|
|
|
|
|
|
|
>
|
|
|
>
>
>
>
>
|
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
...
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
#
# NOTE: Verify that the current call frame is correct and that the
# interpreter call stack has not been imbalanced by previous
# tests or other errors. This check only applies to Eagle.
#
if {[isEagle]} then {
catch {
#
# NOTE: Check the name of the current call frame against the one
# that should be used for evaluating this script file.
#
if {[object invoke -flags +NonPublic \
Interpreter.GetActive.CurrentFrame Name] ne \
[list source [file normalize [info script]]]} then {
unset -nocomplain test_suite_running
error "cannot run, current frame is not for this script"
}
}
}
#
# NOTE: Make sure all the variables used by this epilogue are unset.
#
unset -nocomplain memory stack name count passedOrSkipped percent \
................................................................................
" microseconds\n"]
}
}
#
# NOTE: Show the ending operation count (for Eagle only).
#
catch {
object invoke -flags +NonPublic Interpreter.GetActive OperationCount
} operationCount
tputs $test_channel [appendArgs "---- ending operation count: " \
$operationCount \n]
unset operationCount
#
# NOTE: Show the current state of the memory.
#
catch {debug memory} memory
tputs $test_channel [appendArgs "---- ending memory: " \
|
Changes to Externals/Eagle/lib/Test1.0/prologue.eagle.
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 .... 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 .... 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 .... 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 .... 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 .... 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 |
#
# NOTE: Verify that the current call frame is correct and that the
# interpreter call stack has not been imbalanced by previous
# tests or other errors. This check only applies to Eagle.
# This block requires the "Eagle.Library" package.
#
if {[isEagle]} then {
#
# NOTE: Check the name of the current call frame against the one
# that should be used for evaluating this script file.
#
if {[object invoke -flags +NonPublic \
Interpreter.GetActive.CurrentFrame Name] ne \
[list source [file normalize [info script]]]} then {
unset -nocomplain test_suite_running
error "cannot run, current frame is not for this script"
}
}
#############################################################################
#
# NOTE: Set the local root directory of the source checkout (i.e. of Eagle
................................................................................
#
checkForTclInstalls $test_channel
}
if {![info exists no(tclReady)]} then {
checkForTclReady $test_channel
}
if {![info exists no(tclShell)]} then {
#
# NOTE: For test "garuda-1.1".
#
checkForTclShell $test_channel
}
................................................................................
}
}
#
# 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 \
*TestNullArray*
checkForObjectMember $test_channel Eagle._Tests.Default \
*TestOutArray*
#
# NOTE: For test "object-7.5".
#
checkForObjectMember $test_channel Eagle._Tests.Default \
*TestEnum*
checkForObjectMember $test_channel Eagle._Tests.Default \
................................................................................
if {![info exists no(callbackCommand)]} then {
checkForCommand $test_channel callback
}
if {![info exists no(libraryCommand)]} then {
checkForCommand $test_channel library
}
if {![info exists no(socketCommand)]} then {
checkForCommand $test_channel socket
}
if {![info exists no(sqlCommand)]} then {
checkForCommand $test_channel sql
................................................................................
tputs $test_channel [appendArgs "---- starting command count: " \
[info cmdcount] \n]
if {[isEagle]} then {
#
# NOTE: Show the starting operation count (for Eagle only).
#
tputs $test_channel [appendArgs "---- starting operation count: " \
[object invoke -flags +NonPublic Interpreter.GetActive \
OperationCount] \n]
#
# NOTE: Record the raw starting performance count, for later use in
# calculating the approximate number of microseconds elapsed.
#
catch {set test_timestamp(startCount) [clock start]}
}
|
> | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | > > > > > |
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 .... 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 .... 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 .... 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 .... 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 .... 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 |
#
# NOTE: Verify that the current call frame is correct and that the
# interpreter call stack has not been imbalanced by previous
# tests or other errors. This check only applies to Eagle.
# This block requires the "Eagle.Library" package.
#
if {[isEagle]} then {
catch {
#
# NOTE: Check the name of the current call frame against the one
# that should be used for evaluating this script file.
#
if {[object invoke -flags +NonPublic \
Interpreter.GetActive.CurrentFrame Name] ne \
[list source [file normalize [info script]]]} then {
unset -nocomplain test_suite_running
error "cannot run, current frame is not for this script"
}
}
}
#############################################################################
#
# NOTE: Set the local root directory of the source checkout (i.e. of Eagle
................................................................................
#
checkForTclInstalls $test_channel
}
if {![info exists no(tclReady)]} then {
checkForTclReady $test_channel
}
if {![info exists no(tclSelect)]} then {
checkForTclSelect $test_channel
}
if {![info exists no(tclShell)]} then {
#
# NOTE: For test "garuda-1.1".
#
checkForTclShell $test_channel
}
................................................................................
}
}
#
# NOTE: Has custom test method support been disabled?
#
if {![info exists no(core)] && ![info exists no(test)]} then {
#
# NOTE: Has optional parameter testing support been disabled?
#
if {![info exists no(testOptionalParameter)]} then {
#
# NOTE: For tests "object-2.81", "object-2.82", "object-2.83",
# and "object-2.84".
#
checkForObjectMember $test_channel Eagle._Tests.Default \
*TestOptionalParameter0*
checkForObjectMember $test_channel Eagle._Tests.Default \
*TestOptionalParameter1*
checkForObjectMember $test_channel Eagle._Tests.Default \
*TestOptionalParameter2*
checkForObjectMember $test_channel Eagle._Tests.Default \
*TestOptionalParameterZ*
}
#
# 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 \
*TestNullArray*
checkForObjectMember $test_channel Eagle._Tests.Default \
*TestOutArray*
#
# NOTE: For tests "object-7.6" and "object-7.7".
#
checkForObjectMember $test_channel Eagle._Tests.Default \
*TestByRefArray*
#
# NOTE: For test "object-7.5".
#
checkForObjectMember $test_channel Eagle._Tests.Default \
*TestEnum*
checkForObjectMember $test_channel Eagle._Tests.Default \
................................................................................
if {![info exists no(callbackCommand)]} then {
checkForCommand $test_channel callback
}
if {![info exists no(libraryCommand)]} then {
checkForCommand $test_channel library
}
if {![info exists no(objectCommand)]} then {
checkForCommand $test_channel object
}
if {![info exists no(socketCommand)]} then {
checkForCommand $test_channel socket
}
if {![info exists no(sqlCommand)]} then {
checkForCommand $test_channel sql
................................................................................
tputs $test_channel [appendArgs "---- starting command count: " \
[info cmdcount] \n]
if {[isEagle]} then {
#
# NOTE: Show the starting operation count (for Eagle only).
#
catch {
object invoke -flags +NonPublic Interpreter.GetActive OperationCount
} operationCount
tputs $test_channel [appendArgs "---- starting operation count: " \
$operationCount \n]
unset operationCount
#
# NOTE: Record the raw starting performance count, for later use in
# calculating the approximate number of microseconds elapsed.
#
catch {set test_timestamp(startCount) [clock start]}
}
|