Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Update Eagle in externals to the latest pre-beta 29 code. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
d4b63fae22d3ca00f5246cb9198d0cc4 |
| User & Date: | mistachkin 2014-01-09 07:56:24 |
Context
|
2014-01-09
| ||
| 09:53 | Pickup upstream Eagle fixes for CacheDictionary and NetFx40 GetHashCode performance issues. check-in: 08dac619aa user: mistachkin tags: trunk | |
| 07:56 | Update Eagle in externals to the latest pre-beta 29 code. check-in: d4b63fae22 user: mistachkin tags: trunk | |
|
2014-01-06
| ||
| 05:34 | Make sure the effective connection flags for the stress test are logged. check-in: 026792f794 user: mistachkin tags: trunk | |
Changes
Changes to Externals/Eagle/bin/Eagle.dll.
cannot compute difference between binary files
Changes to Externals/Eagle/bin/EagleShell.exe.
cannot compute difference between binary files
Changes to Externals/Eagle/bin/x64/Spilornis.dll.
cannot compute difference between binary files
Changes to Externals/Eagle/bin/x86/Spilornis.dll.
cannot compute difference between binary files
Changes to Externals/Eagle/lib/Eagle1.0/test.eagle.
64 65 66 67 68 69 70 71 72 73 74 75 76 77 ... 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 ... 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 ... 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 .... 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 .... 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 .... 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 |
if {[string length $newString] > 0} then {
appendSharedLogFile $fileName $newString
}
unset ::test_log_queue($entry)
}
}
#
# NOTE: If an empty string is supplied by the caller, do nothing.
#
if {[string length $string] > 0} then {
appendSharedLogFile $fileName $string
................................................................................
# TODO: Possibly add a check if the file actually exists
# here.
#
if {[string length $value] > 0} then {
#
# NOTE: *EXTERNAL* Use verbatim, no normalization.
#
if {$automatic} then {
#
# NOTE: In automatic mode, the environment variable
# value simply represents another candidate
# Tcl shell (i.e. it does not halt the search
# for other candidate Tcl shells).
#
lappend shells $value
................................................................................
} else {
#
# NOTE: We are missing the suffix, return nothing.
#
return ""
}
}
proc testExec { commandName options args } {
set command [list exec]
if {[llength $options] > 0} then {eval lappend command $options}
lappend command -- $commandName
if {[llength $args] > 0} then {eval lappend command $args}
if {[info exists ::no(exec)]} then {
tputs $::test_channel [appendArgs "---- skipping command: " $command \n]
set procName [lindex [info level [info level]] 0]
error "test use of \[$procName\] has been disabled"
} else {
tputs $::test_channel [appendArgs "---- running command: " $command \n]
return [uplevel 1 $command]
}
}
................................................................................
lappend command mono \
[appendArgs \" [file nativename $commandName] \"]
} else {
lappend command $commandName
}
if {[llength $args] > 0} then {eval lappend command $args}
if {[info exists ::no(exec)]} then {
tputs $::test_channel [appendArgs "---- skipping command: " $command \n]
set procName [lindex [info level [info level]] 0]
error "test use of \[$procName\] has been disabled"
} else {
tputs $::test_channel [appendArgs "---- running command: " $command \n]
return [uplevel 1 $command]
}
}
proc execTestShell { options args } {
if {[info exists ::no(exec)]} then {
tputs $::test_channel [appendArgs \
"---- skipping nested shell: exec " [string trim [appendArgs \
$options " " -- " \"" [info nameofexecutable] "\" " $args]] \n]
set procName [lindex [info level [info level]] 0]
error "test use of \[$procName\] has been disabled"
} else {
tputs $::test_channel [appendArgs \
"---- running nested shell: exec " [string trim [appendArgs \
$options " " -- " \"" [info nameofexecutable] "\" " $args]] \n]
return [uplevel 1 execShell [list $options] $args]
................................................................................
}
proc reportTestPercent {
channel percent totalFiles failedFiles leakedFiles } {
if {[isEagle]} then {
set totalTests $::eagle_tests(Total)
set failedTests $::eagle_tests(Failed)
} else {
set totalTests $::tcltest::numTests(Total)
set failedTests $::tcltest::numTests(Failed)
}
set status [appendArgs \
"---- test suite running, about " $percent "% complete (" \
$totalTests " tests total, " $failedTests " tests failed, " \
$totalFiles " files total, " $failedFiles " files failed, " \
$leakedFiles " files leaked)..."]
tputs $channel [appendArgs $status \n]
if {[isEagle]} then {
host title $status
}
}
................................................................................
proc getTkVersionForTclShell { {shell ""} } {
return [testExecTclScript {
puts -nonewline stdout [package require Tk]; exit
} $shell]
}
proc getGarudaDll {} {
#
# NOTE: Get the Garuda DLL of the same platform (i.e. machine type)
# as the native Tcl shell.
#
if {[info exists ::base_path]} then {
#
# NOTE: Get the effective test configuration.
................................................................................
#
# NOTE: Get the effective test suffix. This is allowed to be an
# empty string.
#
set suffix [getTestSuffix]
#
# NOTE: Build the full path and file name of the Garuda DLL, using
# the Eagle base path. Currently, this will only work
# correctly if the test suite is being run from inside the
# source tree.
#
return [file join $::base_path bin \
[machineToPlatform [getMachineForTclShell]] [appendArgs \
$configuration Dll $suffix] [appendArgs Garuda [info \
sharedlibextension]]]
} else {
#
# NOTE: We are missing the base path, return nothing.
#
return ""
}
}
|
> > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > < > < > < > < | > > < > > | | | > > > > > > > > | | < |
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 ... 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 ... 953 954 955 956 957 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 1000 1001 .... 1014 1015 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 .... 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 .... 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 .... 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 |
if {[string length $newString] > 0} then {
appendSharedLogFile $fileName $newString
}
unset ::test_log_queue($entry)
}
#
# NOTE: If all entries in the test log queue were just processed,
# unset the entire array now.
#
if {[array size test_log_queue] == 0} then {
unset ::test_log_queue
}
}
#
# NOTE: If an empty string is supplied by the caller, do nothing.
#
if {[string length $string] > 0} then {
appendSharedLogFile $fileName $string
................................................................................
# TODO: Possibly add a check if the file actually exists
# here.
#
if {[string length $value] > 0} then {
#
# NOTE: *EXTERNAL* Use verbatim, no normalization.
#
if {$automatic && [isEagle]} then {
#
# NOTE: In automatic mode, the environment variable
# value simply represents another candidate
# Tcl shell (i.e. it does not halt the search
# for other candidate Tcl shells).
#
lappend shells $value
................................................................................
} else {
#
# NOTE: We are missing the suffix, return nothing.
#
return ""
}
}
#
# NOTE: This procedure should return non-zero if the [exec] command may be
# used by the specified test package procedure.
#
proc canTestExec { procName } {
if {[info exists ::no(exec)]} then {
return false
}
if {[info exists ::no(canTestExec)]} then {
return false
}
if {[string length $procName] > 0 && \
[info exists [appendArgs ::no(canTestExec. $procName )]]} then {
return false
}
return true
}
proc testExec { commandName options args } {
set command [list exec]
if {[llength $options] > 0} then {eval lappend command $options}
lappend command -- $commandName
if {[llength $args] > 0} then {eval lappend command $args}
set procName [lindex [info level [info level]] 0]
if {![canTestExec $procName]} then {
tputs $::test_channel [appendArgs "---- skipping command: " $command \n]
error "test use of \[$procName\] has been disabled"
} else {
tputs $::test_channel [appendArgs "---- running command: " $command \n]
return [uplevel 1 $command]
}
}
................................................................................
lappend command mono \
[appendArgs \" [file nativename $commandName] \"]
} else {
lappend command $commandName
}
if {[llength $args] > 0} then {eval lappend command $args}
set procName [lindex [info level [info level]] 0]
if {![canTestExec $procName]} then {
tputs $::test_channel [appendArgs "---- skipping command: " $command \n]
error "test use of \[$procName\] has been disabled"
} else {
tputs $::test_channel [appendArgs "---- running command: " $command \n]
return [uplevel 1 $command]
}
}
proc execTestShell { options args } {
set procName [lindex [info level [info level]] 0]
if {![canTestExec $procName]} then {
tputs $::test_channel [appendArgs \
"---- skipping nested shell: exec " [string trim [appendArgs \
$options " " -- " \"" [info nameofexecutable] "\" " $args]] \n]
error "test use of \[$procName\] has been disabled"
} else {
tputs $::test_channel [appendArgs \
"---- running nested shell: exec " [string trim [appendArgs \
$options " " -- " \"" [info nameofexecutable] "\" " $args]] \n]
return [uplevel 1 execShell [list $options] $args]
................................................................................
}
proc reportTestPercent {
channel percent totalFiles failedFiles leakedFiles } {
if {[isEagle]} then {
set totalTests $::eagle_tests(Total)
set failedTests $::eagle_tests(Failed)
set skippedTests $::eagle_tests(Skipped)
} else {
set totalTests $::tcltest::numTests(Total)
set failedTests $::tcltest::numTests(Failed)
set skippedTests $::tcltest::numTests(Skipped)
}
set status [appendArgs \
"---- test suite running, about " $percent "% complete (" \
$totalTests " tests total, " $failedTests " tests failed, " \
$skippedTests " tests skipped, " $totalFiles " files total, " \
$failedFiles " files failed, " $leakedFiles " files leaked)..."]
tputs $channel [appendArgs $status \n]
if {[isEagle]} then {
host title $status
}
}
................................................................................
proc getTkVersionForTclShell { {shell ""} } {
return [testExecTclScript {
puts -nonewline stdout [package require Tk]; exit
} $shell]
}
proc getGarudaDll { {machine ""} } {
#
# NOTE: Get the Garuda DLL of the same platform (i.e. machine type)
# as the native Tcl shell.
#
if {[info exists ::base_path]} then {
#
# NOTE: Get the effective test configuration.
................................................................................
#
# NOTE: Get the effective test suffix. This is allowed to be an
# empty string.
#
set suffix [getTestSuffix]
#
# NOTE: If necessary, automatically detect the machine for the Tcl
# shell that we plan on using.
#
if {[string length $machine] == 0} then {
set machine [getMachineForTclShell]
}
#
# NOTE: Build the full path and file name of the Garuda DLL, using
# the Eagle base path. Currently, this will only work
# correctly if the test suite is being run from inside the
# source tree.
#
return [file join $::base_path bin \
[machineToPlatform $machine] [appendArgs $configuration Dll \
$suffix] [appendArgs Garuda [info sharedlibextension]]]
} else {
#
# NOTE: We are missing the base path, return nothing.
#
return ""
}
}
|
Changes to Externals/Eagle/lib/Test1.0/constraints.eagle.
16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 ... 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 ... 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 ... 765 766 767 768 769 770 771 772 773 774 775 776 777 778 .... 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 .... 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 .... 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 .... 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 .... 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 |
#
# NOTE: Use our own namespace here because even though we do not directly
# support namespaces ourselves, we do not want to pollute the global
# namespace if this script actually ends up being evaluated in Tcl.
#
namespace eval ::Eagle {
proc getKnownMonoVersions {} {
#
# NOTE: This job of this procedure is to return the list of "known"
# versions of Mono supported by the test suite infrastructure.
#
return [list \
[list 2 0] [list 2 2] [list 2 4] [list 2 6] [list 2 8] [list 2 10] \
[list 2 11] [list 2 12] [list 3 0] [list 3 1] [list 3 2] [list 3 3] \
[list 3 4] [list 3 5] [list 3 6]]
}
proc checkForTestSuiteFiles { channel } {
tputs $channel "---- checking for test suite files... "
#
# NOTE: Start out with no test suite files to check.
#
................................................................................
tputs $channel no\n
}
proc checkForFossil { channel } {
tputs $channel "---- checking for Fossil... "
if {[catch {exec -- fossil version} version] == 0} then {
set version [string trim $version]
set pattern {^This is fossil version (.*) \[([0-9a-f]+)\]\
\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2} UTC$}
if {[regexp -- $pattern $version dummy version sourceId]} then {
#
# NOTE: Add a constraint to show that the Fossil executable
................................................................................
addConstraint fossil_version
#
# NOTE: Append the version of Fossil currently in use.
#
append result version " " $version " \[" $sourceId \]
if {[catch {exec -- fossil remote} remote] == 0} then {
set remote [string trim $remote]; set valid false
if {[isEagle]} then {
#
# NOTE: With Eagle, we can actually validate the URI.
#
if {[uri isvalid $remote]} then {
................................................................................
proc checkForTestExec { channel } {
tputs $channel "---- checking for test use of \"exec\" command... "
if {![info exists ::no(testExec)]} then {
addConstraint testExec
tputs $channel yes\n
} else {
tputs $channel no\n
}
}
proc checkForTestMachine { channel } {
tputs $channel "---- checking for test machine... "
................................................................................
return
}
}
tputs $channel no\n
}
}
if {[isEagle]} then {
###########################################################################
############################ BEGIN Eagle ONLY #############################
###########################################################################
proc checkForSoftwareUpdateTrust { channel } {
................................................................................
-bit " " $::tcl_platform(machine) \n]
} else {
tputs $channel "no, unknown\n"
}
}
proc checkForGarudaDll { channel } {
#
# NOTE: Check for the Garuda DLL of the same platform (i.e. machine
# type) as the native Tcl shell.
#
return [checkForFile $channel [getGarudaDll]]
}
proc checkForCulture { channel } {
tputs $channel "---- checking for culture... "
#
# NOTE: Grab the current culture.
................................................................................
#
# HACK: If this returns "error" that normally indicates an error was
# caught during [exec] (i.e. the native Tcl shell could not be
# executed).
#
set prefix "---- checking for Tcl shell version... "
if {[catch {getTclVersionForTclShell} version] == 0 && \
$version ne "error"} then {
#
# NOTE: Yes, a native Tcl shell appears to be available.
#
addConstraint tclShell
#
................................................................................
# HACK: We do not care about the Tk version returned from this
# procedure, we only care if it returns "error" because that
# would indicate an error was caught during [exec] (i.e. the
# native Tcl shell could not be executed).
#
set prefix "---- checking for Tk package version... "
if {[catch {getTkVersionForTclShell} version] == 0 && \
$version ne "error"} then {
#
# NOTE: Yes, a native Tk package appears to be available.
#
addConstraint tkPackage
tputs $channel [appendArgs $prefix "yes (" $version ")\n"]
................................................................................
###########################################################################
#
# NOTE: We need several of our test constraint related commands in the
# global namespace.
#
exportAndImportPackageCommands [namespace current] [list \
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 checkForBigLists \
checkForStackIntensive checkForInteractive checkForInteractiveCommand \
checkForUserInteraction checkForNetwork checkForCompileOption] false \
false
###########################################################################
############################## END Tcl ONLY ###############################
###########################################################################
}
#
# NOTE: Provide the Eagle test constraints package to the interpreter.
#
package provide Eagle.Test.Constraints \
[expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}
|
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | > | > | | | |
16 17 18 19 20 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 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 ... 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 ... 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 ... 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 .... 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 1503 1504 1505 1506 1507 1508 1509 1510 1511 .... 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 .... 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 .... 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 .... 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 |
#
# NOTE: Use our own namespace here because even though we do not directly
# support namespaces ourselves, we do not want to pollute the global
# namespace if this script actually ends up being evaluated in Tcl.
#
namespace eval ::Eagle {
proc getKnownCompileOptions {} {
return [list \
APPDOMAINS APPROVED_VERBS ARM ASSEMBLY_RELEASE \
ASSEMBLY_STRONG_NAME_TAG ASSEMBLY_TAG ASSEMBLY_TEXT ASSEMBLY_URI \
BREAK_ON_EXITING BREAKPOINTS CACHE_ARGUMENT_TOSTRING \
CACHE_ARGUMENTLIST_TOSTRING CACHE_DICTIONARY CACHE_RESULT_TOSTRING \
CACHE_STATISTICS CACHE_STRINGLIST_TOSTRING CALLBACK_QUEUE CAS_POLICY \
CODE_ANALYSIS COM_TYPE_CACHE CONSOLE DAEMON DATA DEAD_CODE DEBUG \
DEBUGGER DEBUGGER_ARGUMENTS 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 NON_WORKING_CODE NOTIFY NOTIFY_ACTIVE \
NOTIFY_ARGUMENTS NOTIFY_GLOBAL NOTIFY_OBJECT OBSOLETE PARSE_CACHE \
PATCHLEVEL POLICY_TRACE PREVIOUS_RESULT RANDOMIZE_ID REMOTING SAMPLE \
SERIALIZATION SHARED_ID_POOL SHELL SOURCE_ID SOURCE_TIMESTAMP STATIC \
TCL TCL_KITS TCL_THREADED TCL_THREADS TCL_UNICODE TCL_WRAPPER TEST \
THREADING THROW_ON_DISPOSED TRACE TYPE_CACHE UNIX VERBOSE WEB \
WINDOWS WINFORMS WIX_30 WIX_35 WIX_36 WIX_37 WIX_38 X64 X86 XML]
}
proc getKnownMonoVersions {} {
#
# NOTE: This job of this procedure is to return the list of "known"
# versions of Mono supported by the test suite infrastructure.
#
return [list \
[list 2 0] [list 2 2] [list 2 4] [list 2 6] [list 2 8] [list 2 10] \
[list 2 11] [list 2 12] [list 3 0] [list 3 1] [list 3 2] [list 3 3] \
[list 3 4] [list 3 5] [list 3 6]]
}
#
# NOTE: This procedure should return non-zero if the native Tcl shell may
# be executed by the test suite infrastructure outside the context
# of any specific tests. The specific tests themselves must make
# use of their own constraints to prevent execution of the native
# Tcl shell.
#
proc canExecTclShell {} {
if {[info exists ::no(exec)]} then {
return false
}
if {[info exists ::no(tcl)]} then {
return false
}
if {[info exists ::no(canExecTclShell)]} then {
return false
}
return true
}
#
# NOTE: This procedure should return non-zero if Fossil may be executed by
# the test suite infrastructure outside the context of any specific
# tests. The specific tests themselves must make use of their own
# constraints to prevent execution of Fossil.
#
proc canExecFossil {} {
if {[info exists ::no(exec)]} then {
return false
}
if {[info exists ::no(fossil)]} then {
return false
}
if {[info exists ::no(canExecFossil)]} then {
return false
}
return true
}
proc checkForTestSuiteFiles { channel } {
tputs $channel "---- checking for test suite files... "
#
# NOTE: Start out with no test suite files to check.
#
................................................................................
tputs $channel no\n
}
proc checkForFossil { channel } {
tputs $channel "---- checking for Fossil... "
if {[canExecFossil] && \
[catch {exec -- fossil version} version] == 0} then {
set version [string trim $version]
set pattern {^This is fossil version (.*) \[([0-9a-f]+)\]\
\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2} UTC$}
if {[regexp -- $pattern $version dummy version sourceId]} then {
#
# NOTE: Add a constraint to show that the Fossil executable
................................................................................
addConstraint fossil_version
#
# NOTE: Append the version of Fossil currently in use.
#
append result version " " $version " \[" $sourceId \]
if {[canExecFossil] && \
[catch {exec -- fossil remote} remote] == 0} then {
set remote [string trim $remote]; set valid false
if {[isEagle]} then {
#
# NOTE: With Eagle, we can actually validate the URI.
#
if {[uri isvalid $remote]} then {
................................................................................
proc checkForTestExec { channel } {
tputs $channel "---- checking for test use of \"exec\" command... "
if {![info exists ::no(testExec)]} then {
addConstraint testExec
tputs $channel yes\n
if {[info exists ::no(exec)]} then {
tputs $channel \
"==== WARNING: running with the \"testExec\" procedure disabled\n"
}
} else {
tputs $channel no\n
}
}
proc checkForTestMachine { channel } {
tputs $channel "---- checking for test machine... "
................................................................................
return
}
}
tputs $channel no\n
}
}
proc checkForKnownCompileOptions { channel } {
#
# NOTE: Check for all "known" compile options.
#
tputs $channel "---- checking for known compile options... "
set options [getKnownCompileOptions]
if {[llength $options] > 0} then {
tputs $channel [appendArgs "yes (" [llength $options] ")\n"]
foreach option $options {
if {![info exists [appendArgs ::no(compile. $option )]]} then {
checkForCompileOption $channel $option
}
}
} else {
tputs $channel no\n
}
}
if {[isEagle]} then {
###########################################################################
############################ BEGIN Eagle ONLY #############################
###########################################################################
proc checkForSoftwareUpdateTrust { channel } {
................................................................................
-bit " " $::tcl_platform(machine) \n]
} else {
tputs $channel "no, unknown\n"
}
}
proc checkForGarudaDll { channel } {
#
# NOTE: Skip automatic Tcl shell machine detection if we are not
# allowed to execute external commands.
#
if {[canExecTclShell]} then {
#
# NOTE: Have the [getGarudaDll] procedure automatically detect the
# machine.
#
set machine ""
} else {
#
# NOTE: Use the machine for this test run.
#
set machine [getTestMachine]
#
# NOTE: Since an empty string means "automatically detect" to the
# [getGarudaDll] procedure, we must make sure the value is
# something else.
#
if {[string length $machine] == 0} then {
set machine unknown
}
}
#
# NOTE: Check for the Garuda DLL of the same platform (i.e. machine
# type) as the native Tcl shell.
#
return [checkForFile $channel [getGarudaDll $machine]]
}
proc checkForCulture { channel } {
tputs $channel "---- checking for culture... "
#
# NOTE: Grab the current culture.
................................................................................
#
# HACK: If this returns "error" that normally indicates an error was
# caught during [exec] (i.e. the native Tcl shell could not be
# executed).
#
set prefix "---- checking for Tcl shell version... "
if {[canExecTclShell] && \
[catch {getTclVersionForTclShell} version] == 0 && \
$version ne "error"} then {
#
# NOTE: Yes, a native Tcl shell appears to be available.
#
addConstraint tclShell
#
................................................................................
# HACK: We do not care about the Tk version returned from this
# procedure, we only care if it returns "error" because that
# would indicate an error was caught during [exec] (i.e. the
# native Tcl shell could not be executed).
#
set prefix "---- checking for Tk package version... "
if {[canExecTclShell] && \
[catch {getTkVersionForTclShell} version] == 0 && \
$version ne "error"} then {
#
# NOTE: Yes, a native Tk package appears to be available.
#
addConstraint tkPackage
tputs $channel [appendArgs $prefix "yes (" $version ")\n"]
................................................................................
###########################################################################
#
# NOTE: We need several of our test constraint related commands in the
# global namespace.
#
exportAndImportPackageCommands [namespace current] [list \
getKnownCompileOptions getKnownMonoVersions canExecTclShell \
canExecFossil 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 checkForBigLists \
checkForStackIntensive checkForInteractive checkForInteractiveCommand \
checkForUserInteraction checkForNetwork checkForCompileOption \
checkForKnownCompileOptions] false false
###########################################################################
############################## END Tcl ONLY ###############################
###########################################################################
}
#
# NOTE: Provide the Eagle test constraints package to the interpreter.
#
package provide Eagle.Test.Constraints \
[expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}
|
Changes to Externals/Eagle/lib/Test1.0/prologue.eagle.
82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 ... 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 ... 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 ... 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 ... 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 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 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 .... 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 .... 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 .... 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 |
}
unset pkg_dir
}
#############################################################################
#
# NOTE: Set the local root directory of the source checkout (i.e. of Eagle
# or whatever project the Eagle binaries are being used by) using a
# Fossil binary in the PATH, if available.
#
if {![info exists root_path] && \
![info exists no(exec)] && ![info exists no(fossil)]} then {
set pattern {^local-root:\s+(.*?)\s+$}
if {[catch {exec -- fossil info} exec] || \
![regexp -line -- $pattern $exec dummy directory]} then {
#
# NOTE: We could not query local root directory of the source checkout
# from Fossil; therefore, attempt to make an educated guess. This
# value will probably be wrong for any project(s) other than Eagle.
# In that case, this value should be overridden by that project to
# reflect the actual local root directory of the source checkout
# for that project.
#
set root_path $base_path
} else {
#
# NOTE: We extracted the local root directory of the source checkout
# from Fossil. Now, make sure it is fully normalized and has no
# trailing slashes.
#
set root_path [file normalize $directory]
}
unset -nocomplain directory dummy exec pattern
}
#############################################################################
#
# NOTE: Set the executable file name for the process, if
# necessary.
#
if {![info exists bin_file]} then {
set bin_file [info nameofexecutable]
}
................................................................................
#############################################################################
#
# 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 \
[appendArgs source " " [file normalize [info script]]]} then {
unset -nocomplain test_suite_running
error "cannot run, current frame is not for this script"
}
}
#############################################################################
#
# NOTE: If command line arguments were supplied, process them now.
#
set test_flags(-suite) ""; # test suite name, default to empty.
................................................................................
if {[info exists test_flags(-tclsh)] && \
[string length $test_flags(-tclsh)] > 0} then {
#
# NOTE: Use the native Tcl shell specified via the command line.
#
set test_tclsh $test_flags(-tclsh)
} else {
if {![info exists no(getTclShellFileName)]} then {
#
# NOTE: Attempt to automatically select the native Tcl shell
# to use.
#
if {![info exists no(warningForTclShell)]} then {
tputs $test_channel \
"==== WARNING: attempting automatic Tcl shell selection...\n"
................................................................................
#
# NOTE: Has machine detection support been disabled?
#
if {![info exists no(machine)]} then {
checkForMachine $test_channel 32 intel; # (i.e. x86)
checkForMachine $test_channel 32 arm; # (i.e. arm)
checkForMachine $test_channel 64 ia64; # (i.e. ia64)
checkForMachine $test_channel 64 amd64; # (i.e. x64)
}
#
# NOTE: Has culture detection support been disabled?
#
if {![info exists no(culture)]} then {
................................................................................
}
#
# NOTE: Has compile/runtime option testing support been disabled?
#
if {![info exists no(compileOptions)]} then {
#
# NOTE: Has callback queue support been enabled (at compile-time)?
#
if {![info exists no(compileCallbackQueue)]} then {
#
# NOTE: For test "commands-1.4".
#
checkForCompileOption $test_channel CALLBACK_QUEUE
}
#
# NOTE: Has legacy CAS policy support been enabled (at compile-time)?
#
if {![info exists no(compileCasPolicy)]} then {
#
# NOTE: For tests "load-1.6" and "load-1.7".
#
checkForCompileOption $test_channel CAS_POLICY
}
#
# NOTE: Has console support been enabled (at compile-time)?
#
if {![info exists no(compileConsole)]} then {
#
# NOTE: For test "host-1.2".
#
checkForCompileOption $test_channel CONSOLE
}
#
# NOTE: Has database support been enabled (at compile-time)?
#
if {![info exists no(compileData)]} then {
#
# NOTE: For tests "sql-1.1" and "upvar-99.1".
#
checkForCompileOption $test_channel DATA
}
#
# NOTE: Has script debugger support been enabled (at compile-time)?
#
if {![info exists no(compileDebugger)]} then {
#
# NOTE: For tests "debug-1.1", "debug-2.1", "debug-3.1" and
# "debug-4.1".
#
checkForCompileOption $test_channel DEBUGGER
}
#
# NOTE: Has application domain management support been enabled (at
# compile-time)?
#
if {![info exists no(compileAppDomains)]} then {
#
# NOTE: For test "interp-1.27".
#
checkForCompileOption $test_channel APPDOMAINS
}
#
# NOTE: Has isolated interpreter support been enabled (at compile-time)?
#
if {![info exists no(compileIsolatedInterpreters)]} then {
#
# NOTE: For test "xaml-1.2".
#
checkForCompileOption $test_channel ISOLATED_INTERPRETERS
}
#
# NOTE: Has expression flags support been enabled (at compile-time)?
#
if {![info exists no(compileExpressionFlags)]} then {
#
# NOTE: For test "function-2.16".
#
checkForCompileOption $test_channel EXPRESSION_FLAGS
}
#
# NOTE: Has isolated plugin support been enabled (at compile-time)?
#
if {![info exists no(compileIsolatedPlugins)]} then {
#
# NOTE: For test "load-1.1.1".
#
checkForCompileOption $test_channel ISOLATED_PLUGINS
}
#
# NOTE: Has PowerShell approved-verbs support been enabled (at
# compile-time)?
#
if {![info exists no(compileApprovedVerbs)]} then {
#
# NOTE: For test "object-4.8".
#
checkForCompileOption $test_channel APPROVED_VERBS
}
#
# NOTE: Has Mono support been enabled (at compile-time)?
#
if {![info exists no(compileMono)]} then {
#
# NOTE: For test "object-4.13".
#
checkForCompileOption $test_channel MONO
}
#
# NOTE: Has Windows support been enabled (at compile-time)?
#
if {![info exists no(compileWindows)]} then {
#
# 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 {
#
# NOTE: For tests "debug-3.2", "expr-3.2", and "host-1.1".
#
checkForCompileOption $test_channel NATIVE
}
#
# NOTE: Has native package support been enabled (at compile-time)?
#
if {![info exists no(compileNativePackage)]} then {
#
# NOTE: For tests "garuda-1.1" and "garuda-1.2".
#
checkForCompileOption $test_channel NATIVE_PACKAGE
}
#
# NOTE: Has network support been enabled (at compile-time)?
#
if {![info exists no(compileNetwork)]} then {
#
# NOTE: For tests "commands-1.4", "socket-1.*", "socket-2.1", and
# "socket-3.1".
#
checkForCompileOption $test_channel NETWORK
}
#
# NOTE: Has native Tcl support been enabled (at compile-time)?
#
if {![info exists no(compileTcl)]} then {
#
# NOTE: For tests "commands-1.1.*", "excel-2.2", "tclCancel-1.1",
# "tclEncoding-1.*", "tclErrorInfo-1.*", "tclLoad-1.*",
# "tclResetCancel-1.1", "tclResetCancel-2.1",
# "tclResetCancel-2.2", "tclResetCancel-3.1",
# "tclResetCancel-4.1", "tclSet-1.1", and "tclSubst-1.1".
#
checkForCompileOption $test_channel TCL
}
#
# NOTE: Has XML support been enabled (at compile-time)?
#
if {![info exists no(compileXml)]} then {
#
# NOTE: For tests "commands-1.4", "object-7.3" and "xml-1.1.*".
#
checkForCompileOption $test_channel XML
}
#
# NOTE: Has serialization support been enabled (at compile-time)?
#
if {![info exists no(compileSerialization)]} then {
#
# NOTE: For test "interp-1.10".
#
checkForCompileOption $test_channel SERIALIZATION
}
#
# NOTE: Has dedicated test support been enabled (at compile-time)?
#
if {![info exists no(compileTest)]} then {
#
# NOTE: For tests "basic-1.20", "basic-1.21", "function-1.1",
# "object-2.1", "object-3.1", "object-4.1", "object-7.1",
# "object-7.2", "object-7.4", "object-14.4", "object-14.5",
# "object-14.6", "remotingServer-1.*", and "debug-5.*".
#
checkForCompileOption $test_channel TEST
}
#
# NOTE: Has threading support been enabled (at compile-time)?
#
if {![info exists no(compileThreading)]} then {
#
# NOTE: For tests "object-10.2" and "object-10.3".
#
checkForCompileOption $test_channel THREADING
}
#
# NOTE: Has Tcl threading support been enabled (at compile-time)?
#
if {![info exists no(compileTclThreaded)]} then {
#
# NOTE: For tests "tclLoad-1.5" and "tclLoad-1.6".
#
checkForCompileOption $test_channel TCL_THREADED
}
#
# NOTE: Has Tcl isolated interpreter thread support been enabled (at
# compile-time)?
#
if {![info exists no(compileTclThreads)]} then {
#
# NOTE: For tests "tclLoad-1.5" and "tclLoad-1.6".
#
checkForCompileOption $test_channel TCL_THREADS
}
#
# NOTE: Has GDI+ drawing support been enabled (at compile-time)?
#
if {![info exists no(compileDrawing)]} then {
checkForCompileOption $test_channel DRAWING
}
#
# NOTE: Has WinForms support been enabled (at compile-time)?
#
if {![info exists no(compileWinForms)]} then {
checkForCompileOption $test_channel WINFORMS
}
#
# NOTE: Has runtime license checking support been disabled (at
# compile-time). This only applies to third-party plugins
# and applications.
#
if {![info exists no(compileLicensing)]} then {
#
# NOTE: This is not currently used by any tests.
#
checkForCompileOption $test_channel LICENSING
}
}
#
# NOTE: Has dynamic loading testing support been disabled?
#
if {![info exists no(dynamic)]} then {
................................................................................
"---- start of Tcl specific test constraints...\n"]
#
# NOTE: Has compile/runtime option testing support been disabled?
#
if {![info exists no(compileOptions)]} then {
#
# NOTE: Has dedicated test support been enabled (at compile-time)?
#
if {![info exists no(compileTest)]} then {
#
# NOTE: For tests "tclLoad-1.17.1" and "tclLoad-1.17.2".
#
checkForCompileOption $test_channel TEST
}
}
###########################################################################
########################### END Tcl Constraints ###########################
###########################################################################
}
................................................................................
#
# NOTE: For Eagle, dump the platform information, including
# the compile options.
#
if {[isEagle]} then {
#
# NOTE: Get the source checkout and tags (i.e. of Eagle or whatever
# project the Eagle binaries are being used by) using a Fossil
# binary in the PATH, if available.
#
if {![info exists no(exec)] && ![info exists no(fossil)]} then {
if {[catch {exec -- fossil info} exec] == 0} then {
set pattern {^checkout:\s+(.*?)\s+$}
if {![regexp -line -- $pattern $exec dummy checkout]} then {
#
# NOTE: We could not query the source checkout from Fossil.
#
................................................................................
set checkout <none>
set tags <none>
}
unset -nocomplain dummy exec pattern
} else {
#
# NOTE: Querying the source checkout from Fossil was disabled.
#
set checkout <none>
set tags <none>
}
tputs $test_channel [appendArgs "---- checkout: " \
$checkout \n]
|
< < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > > > > > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > > > > > > > > > | | | | | | | > > > > > | | | | < | |
82 83 84 85 86 87 88 89 90 91 92 93 94 95 ... 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 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 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 ... 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 ... 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 .... 1012 1013 1014 1015 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 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 .... 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 .... 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 .... 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 |
}
unset pkg_dir
}
#############################################################################
#
# NOTE: Set the executable file name for the process, if
# necessary.
#
if {![info exists bin_file]} then {
set bin_file [info nameofexecutable]
}
................................................................................
#############################################################################
#
# 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 \
[appendArgs 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
# or whatever project the Eagle binaries are being used by) using a
# Fossil binary in the PATH, if available. This block now requires
# the "Eagle.Test.Constraints" package.
#
if {![info exists root_path]} then {
#
# NOTE: Is the use of Fossil by the test suite allowed?
#
if {[canExecFossil]} then {
set pattern {^local-root:\s+(.*?)\s+$}
if {[catch {exec -- fossil info} exec] || \
![regexp -line -- $pattern $exec dummy directory]} then {
#
# NOTE: We could not query local root directory of the source
# checkout from Fossil; therefore, attempt to make an
# educated guess. This value will probably be wrong for
# any project(s) other than Eagle. In that case, this
# value should be overridden by that project to reflect
# the actual local root directory of the source checkout
# for that project.
#
set root_path $base_path
} else {
#
# NOTE: We extracted the local root directory of the source
# checkout from Fossil. Now, make sure it is fully
# normalized and has no trailing slashes.
#
set root_path [file normalize $directory]
}
unset -nocomplain directory dummy exec pattern
} else {
#
# NOTE: Use of Fossil by the test suite is forbidden. Fallback
# to using the base path.
#
set root_path $base_path
}
}
#############################################################################
#
# NOTE: If command line arguments were supplied, process them now.
#
set test_flags(-suite) ""; # test suite name, default to empty.
................................................................................
if {[info exists test_flags(-tclsh)] && \
[string length $test_flags(-tclsh)] > 0} then {
#
# NOTE: Use the native Tcl shell specified via the command line.
#
set test_tclsh $test_flags(-tclsh)
} else {
if {[canExecTclShell] && \
![info exists no(getTclShellFileName)]} then {
#
# NOTE: Attempt to automatically select the native Tcl shell
# to use.
#
if {![info exists no(warningForTclShell)]} then {
tputs $test_channel \
"==== WARNING: attempting automatic Tcl shell selection...\n"
................................................................................
#
# NOTE: Has machine detection support been disabled?
#
if {![info exists no(machine)]} then {
checkForMachine $test_channel 32 intel; # (i.e. x86)
checkForMachine $test_channel 32 arm; # (i.e. arm)
checkForMachine $test_channel 64 ia64; # (i.e. itanium)
checkForMachine $test_channel 64 amd64; # (i.e. x64)
}
#
# NOTE: Has culture detection support been disabled?
#
if {![info exists no(culture)]} then {
................................................................................
}
#
# NOTE: Has compile/runtime option testing support been disabled?
#
if {![info exists no(compileOptions)]} then {
#
# NOTE: Has "known" compile option testing support been disabled?
#
if {![info exists no(knownCompileOptions)]} then {
#
# NOTE: Check for all "known" compile options.
#
checkForKnownCompileOptions $test_channel
} else {
#
# NOTE: Has callback queue support been enabled (at compile-time)?
#
if {![info exists no(compileCallbackQueue)]} then {
#
# NOTE: For tests "basic-1.54" and "commands-1.4".
#
checkForCompileOption $test_channel CALLBACK_QUEUE
}
#
# NOTE: Has legacy CAS policy support been enabled (at compile-time)?
#
if {![info exists no(compileCasPolicy)]} then {
#
# NOTE: For tests "load-1.6" and "load-1.7".
#
checkForCompileOption $test_channel CAS_POLICY
}
#
# NOTE: Has console support been enabled (at compile-time)?
#
if {![info exists no(compileConsole)]} then {
#
# NOTE: For test "host-1.2".
#
checkForCompileOption $test_channel CONSOLE
}
#
# NOTE: Has database support been enabled (at compile-time)?
#
if {![info exists no(compileData)]} then {
#
# NOTE: For tests "sql-1.1" and "upvar-99.1".
#
checkForCompileOption $test_channel DATA
}
#
# NOTE: Has script debugger support been enabled (at compile-time)?
#
if {![info exists no(compileDebugger)]} then {
#
# NOTE: For tests "debug-1.1", "debug-2.1", "debug-3.1" and
# "debug-4.1".
#
checkForCompileOption $test_channel DEBUGGER
}
#
# NOTE: Has application domain management support been enabled (at
# compile-time)?
#
if {![info exists no(compileAppDomains)]} then {
#
# NOTE: For test "interp-1.27".
#
checkForCompileOption $test_channel APPDOMAINS
}
#
# NOTE: Has isolated interpreter support been enabled (at compile-time)?
#
if {![info exists no(compileIsolatedInterpreters)]} then {
#
# NOTE: For test "xaml-1.2".
#
checkForCompileOption $test_channel ISOLATED_INTERPRETERS
}
#
# NOTE: Has expression flags support been enabled (at compile-time)?
#
if {![info exists no(compileExpressionFlags)]} then {
#
# NOTE: For test "function-2.16".
#
checkForCompileOption $test_channel EXPRESSION_FLAGS
}
#
# NOTE: Has isolated plugin support been enabled (at compile-time)?
#
if {![info exists no(compileIsolatedPlugins)]} then {
#
# NOTE: For test "load-1.1.1".
#
checkForCompileOption $test_channel ISOLATED_PLUGINS
}
#
# NOTE: Has PowerShell approved-verbs support been enabled (at
# compile-time)?
#
if {![info exists no(compileApprovedVerbs)]} then {
#
# NOTE: For test "object-4.8".
#
checkForCompileOption $test_channel APPROVED_VERBS
}
#
# NOTE: Has Mono support been enabled (at compile-time)?
#
if {![info exists no(compileMono)]} then {
#
# NOTE: For test "object-4.13".
#
checkForCompileOption $test_channel MONO
}
#
# NOTE: Has Windows support been enabled (at compile-time)?
#
if {![info exists no(compileWindows)]} then {
#
# 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 {
#
# NOTE: For tests "debug-3.2", "expr-3.2", and "host-1.1".
#
checkForCompileOption $test_channel NATIVE
}
#
# NOTE: Has native package support been enabled (at compile-time)?
#
if {![info exists no(compileNativePackage)]} then {
#
# NOTE: For tests "garuda-1.1" and "garuda-1.2".
#
checkForCompileOption $test_channel NATIVE_PACKAGE
}
#
# NOTE: Has network support been enabled (at compile-time)?
#
if {![info exists no(compileNetwork)]} then {
#
# NOTE: For tests "commands-1.4", "socket-1.*", "socket-2.1", and
# "socket-3.1".
#
checkForCompileOption $test_channel NETWORK
}
#
# NOTE: Has native Tcl support been enabled (at compile-time)?
#
if {![info exists no(compileTcl)]} then {
#
# NOTE: For tests "commands-1.1.*", "excel-2.2", "tclCancel-1.1",
# "tclEncoding-1.*", "tclErrorInfo-1.*", "tclLoad-1.*",
# "tclResetCancel-1.1", "tclResetCancel-2.1",
# "tclResetCancel-2.2", "tclResetCancel-3.1",
# "tclResetCancel-4.1", "tclSet-1.1", and "tclSubst-1.1".
#
checkForCompileOption $test_channel TCL
}
#
# NOTE: Has XML support been enabled (at compile-time)?
#
if {![info exists no(compileXml)]} then {
#
# NOTE: For tests "commands-1.4", "object-7.3" and "xml-1.1.*".
#
checkForCompileOption $test_channel XML
}
#
# NOTE: Has serialization support been enabled (at compile-time)?
#
if {![info exists no(compileSerialization)]} then {
#
# NOTE: For test "interp-1.10".
#
checkForCompileOption $test_channel SERIALIZATION
}
#
# NOTE: Has dedicated test support been enabled (at compile-time)?
#
if {![info exists no(compileTest)]} then {
#
# NOTE: For tests "basic-1.20", "basic-1.21", "function-1.1",
# "object-2.1", "object-3.1", "object-4.1", "object-7.1",
# "object-7.2", "object-7.4", "object-14.4", "object-14.5",
# "object-14.6", "remotingServer-1.*", and "debug-5.*".
#
checkForCompileOption $test_channel TEST
}
#
# NOTE: Has threading support been enabled (at compile-time)?
#
if {![info exists no(compileThreading)]} then {
#
# NOTE: For tests "object-10.2" and "object-10.3".
#
checkForCompileOption $test_channel THREADING
}
#
# NOTE: Has Tcl threading support been enabled (at compile-time)?
#
if {![info exists no(compileTclThreaded)]} then {
#
# NOTE: For tests "tclLoad-1.5" and "tclLoad-1.6".
#
checkForCompileOption $test_channel TCL_THREADED
}
#
# NOTE: Has Tcl isolated interpreter thread support been enabled (at
# compile-time)?
#
if {![info exists no(compileTclThreads)]} then {
#
# NOTE: For tests "tclLoad-1.5" and "tclLoad-1.6".
#
checkForCompileOption $test_channel TCL_THREADS
}
#
# NOTE: Has GDI+ drawing support been enabled (at compile-time)?
#
if {![info exists no(compileDrawing)]} then {
checkForCompileOption $test_channel DRAWING
}
#
# NOTE: Has WinForms support been enabled (at compile-time)?
#
if {![info exists no(compileWinForms)]} then {
checkForCompileOption $test_channel WINFORMS
}
#
# NOTE: Has runtime license checking support been disabled (at
# compile-time). This only applies to third-party plugins
# and applications.
#
if {![info exists no(compileLicensing)]} then {
#
# NOTE: This is not currently used by any tests.
#
checkForCompileOption $test_channel LICENSING
}
}
}
#
# NOTE: Has dynamic loading testing support been disabled?
#
if {![info exists no(dynamic)]} then {
................................................................................
"---- start of Tcl specific test constraints...\n"]
#
# NOTE: Has compile/runtime option testing support been disabled?
#
if {![info exists no(compileOptions)]} then {
#
# NOTE: Has "known" compile option testing support been disabled?
#
if {![info exists no(knownCompileOptions)]} then {
#
# NOTE: Check for all "known" compile options.
#
checkForKnownCompileOptions $test_channel
} else {
#
# NOTE: Has dedicated test support been enabled (at compile-time)?
#
if {![info exists no(compileTest)]} then {
#
# NOTE: For tests "tclLoad-1.17.1" and "tclLoad-1.17.2".
#
checkForCompileOption $test_channel TEST
}
}
}
###########################################################################
########################### END Tcl Constraints ###########################
###########################################################################
}
................................................................................
#
# NOTE: For Eagle, dump the platform information, including
# the compile options.
#
if {[isEagle]} then {
#
# NOTE: Is the use of Fossil by the test suite allowed?
#
if {[canExecFossil]} then {
#
# NOTE: Get the source checkout and tags (i.e. of Eagle or whatever
# project the Eagle binaries are being used by) using a Fossil
# binary in the PATH, if available.
#
if {[catch {exec -- fossil info} exec] == 0} then {
set pattern {^checkout:\s+(.*?)\s+$}
if {![regexp -line -- $pattern $exec dummy checkout]} then {
#
# NOTE: We could not query the source checkout from Fossil.
#
................................................................................
set checkout <none>
set tags <none>
}
unset -nocomplain dummy exec pattern
} else {
#
# NOTE: Use of Fossil by the test suite is forbidden.
#
set checkout <none>
set tags <none>
}
tputs $test_channel [appendArgs "---- checkout: " \
$checkout \n]
|