System.Data.SQLite
Check-in [cafe9568f1]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Update Eagle 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: cafe9568f1c3b381ba35caf4564e94bb964b111a
User & Date: mistachkin 2014-09-04 02:41:58
Context
2014-09-04
02:43
Updates to the test suite infrastructure to handle Eagle integration changes. Cherrypick of [e68410521b]. check-in: 320319609f user: mistachkin tags: trunk
02:41
Update Eagle in externals to the latest trunk code. check-in: cafe9568f1 user: mistachkin tags: trunk
2014-08-19
17:58
Add per-connection caching of the 'Use_SQLiteConvert_DefaultDbType' and 'Use_SQLiteConvert_DefaultTypeName' settings. Pursuant to [58ed318f2f]. check-in: 948fd5b3a3 user: mistachkin tags: trunk
Changes
Hide Diffs Unified Diffs Show Whitespace Changes Patch

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/EagleShell32.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/init.eagle.

99
100
101
102
103
104
105

















106
107
108
109
110
111
112
...
914
915
916
917
918
919
920








921

922
923
924
925
926
927

928
929
930



931

932















933
934
935
936
937
938
939
....
1810
1811
1812
1813
1814
1815
1816

1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
....
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
....
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
....
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
....
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
....
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
  #       in both Tcl and Eagle and must return non-zero only when
  #       running in Eagle on Mono.
  #
  proc isMono {} {
    return [expr {[info exists ::eagle_platform(runtime)] && \
        [string compare -nocase mono $::eagle_platform(runtime)] == 0}]
  }

















 
  proc getEnvironmentVariable { name } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    return [expr {[info exists ::env($name)] ? $::env($name) : ""}]
  }
................................................................................
      #       for the platform (i.e. the ones used to compile the Eagle core
      #       library assembly).
      #
      set platformOptions [expr { \
          [info exists ::eagle_platform(compileOptions)] ? \
          $::eagle_platform(compileOptions) : [list]}]









      if {[llength $platformOptions] > 0} then {

        #
        # NOTE: Grab the existing compiler options, if any.
        #
        set compilerOptions [$parameters CompilerOptions]

        if {"DEBUG" in $platformOptions} then {

          append compilerOptions " /define:DEBUG"
        }




        if {"TRACE" in $platformOptions} then {

          append compilerOptions " /define:TRACE"















        }

        #
        # NOTE: Reset the compiler options to the pre-existing ones plus the
        #       extra defines we may have added (above).
        #
        $parameters CompilerOptions $compilerOptions
................................................................................
        set length [string length $name]

        if {$length > $maxLength} {
          set maxLength $length
        }
      }


      set maxLength [expr {$maxLength + [string length $a] + 2}]
      set hostLength [lindex [getHostSize] 0]
      set valueLength [expr {$hostLength - $maxLength - 5}]; # " ... "

      foreach name $names {
        #
        # NOTE: Format the array element name for display.
        #
        set nameString [appendArgs $a ( $name )]

        #
        # NOTE: If the value by itself is too long to fit on one host line,
        #       just truncate and ellipsis it.
        #
        set valueString $array($name)

        if {[string length $valueString] > $valueLength} then {
          set valueString [appendArgs [string range $valueString 0 \
              [expr {$valueLength - 4}]] " ..."]
        }

        #
................................................................................
      }
    }
 
    proc findDirectories { pattern } {
      #
      # NOTE: Block non-Windows platforms since this is Windows specific.
      #
      if {$::tcl_platform(platform) ne "windows"} then {
        error "not supported on this operating system"
      }

      #
      # NOTE: This should work properly in Eagle only.
      #
      set dir ""; set result [list]
................................................................................
      return $result
    }
 
    proc findFiles { pattern } {
      #
      # NOTE: Block non-Windows platforms since this is Windows specific.
      #
      if {$::tcl_platform(platform) ne "windows"} then {
        error "not supported on this operating system"
      }

      #
      # NOTE: This should work properly in Eagle only.
      #
      set fileName ""; set result [list]
................................................................................
      return $result
    }
 
    proc findFilesRecursive { pattern } {
      #
      # NOTE: Block non-Windows platforms since this is Windows specific.
      #
      if {$::tcl_platform(platform) ne "windows"} then {
        error "not supported on this operating system"
      }

      #
      # NOTE: This should work properly in Eagle only.
      #
      set fileName ""; set result [list]
................................................................................
      return $result
    }
 
    proc findFilesRecursive { pattern } {
      #
      # NOTE: Block non-Windows platforms since this is Windows specific.
      #
      if {$::tcl_platform(platform) ne "windows"} then {
        error "not supported on this operating system"
      }

      #
      # NOTE: This should work properly in Tcl only.
      #
      set result [list]
................................................................................
    }
 
    #
    # NOTE: Exports the necessary commands from this package and import them
    #       into the global namespace.
    #
    exportAndImportPackageCommands [namespace current] [list \
        isEagle isWindows haveGaruda isTclThread isMono \
        getEnvironmentVariable combineFlags getCompileInfo getPlatformInfo \
        getPluginPath appendArgs lappendArgs getDictionaryValue \
        getColumnValue getRowColumnValue tqputs tqlog readFile \
        readSharedFile writeFile appendFile appendLogFile appendSharedFile \
        appendSharedLogFile readAsciiFile writeAsciiFile readUnicodeFile \
        writeUnicodeFile getDirResultPath addToPath removeFromPath execShell \
        lshuffle ldifference filter map reduce getLengthModifier debug \







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
|
>






>
|
|

>
>
>

>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>








|





|







 







|







 







|







 







|







 







|







 







|







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
...
931
932
933
934
935
936
937
938
939
940
941
942
943
944
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
973
974
975
976
977
978
979
980
981
982
983
984
985
....
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
....
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
....
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
....
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
....
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
....
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
  #       in both Tcl and Eagle and must return non-zero only when
  #       running in Eagle on Mono.
  #
  proc isMono {} {
    return [expr {[info exists ::eagle_platform(runtime)] && \
        [string compare -nocase mono $::eagle_platform(runtime)] == 0}]
  }
 
  #
  # NOTE: This procedure returns non-zero if the specified file names refer
  #       to the same file, using the most robust method available for the
  #       script engine and platform.
  #
  proc isSameFileName { fileName1 fileName2 } {
    if {[isEagle]} then {
      return [file same $fileName1 $fileName2]
    } else {
      if {[isWindows]} then {
        return [string equal -nocase $fileName1 $fileName2]
      } else {
        return [string equal $fileName1 $fileName2]
      }
    }
  }
 
  proc getEnvironmentVariable { name } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    return [expr {[info exists ::env($name)] ? $::env($name) : ""}]
  }
................................................................................
      #       for the platform (i.e. the ones used to compile the Eagle core
      #       library assembly).
      #
      set platformOptions [expr { \
          [info exists ::eagle_platform(compileOptions)] ? \
          $::eagle_platform(compileOptions) : [list]}]

      #
      # NOTE: Permit extra C# compiler options to be passed via the global
      #       array element "csharpOptions", if it exists.
      #
      set csharpOptions [expr { \
          [info exists ::eagle_platform(csharpOptions)] ? \
          $::eagle_platform(csharpOptions) : [list]}]

      if {[llength $platformOptions] > 0 || \
          [llength $csharpOptions] > 0} then {
        #
        # NOTE: Grab the existing compiler options, if any.
        #
        set compilerOptions [$parameters CompilerOptions]

        if {"DEBUG" in $platformOptions} then {
          if {[string length $compilerOptions] > 0} then {
            append compilerOptions " "
          }

          append compilerOptions /define:DEBUG
        }

        if {"TRACE" in $platformOptions} then {
          if {[string length $compilerOptions] > 0} then {
            append compilerOptions " "
          }

          append compilerOptions /define:TRACE
        }

        #
        # NOTE: Append the configured extra C# compiler options configured
        #       via the global array element "csharpOptions", if any.
        #
        foreach csharpOption $csharpOptions {
          if {[string length $compilerOptions] > 0} then {
            append compilerOptions " "
          }

          append compilerOptions $csharpOption
        }

        #
        # NOTE: Reset the compiler options to the pre-existing ones plus the
        #       extra defines we may have added (above).
        #
        $parameters CompilerOptions $compilerOptions
................................................................................
        set length [string length $name]

        if {$length > $maxLength} {
          set maxLength $length
        }
      }

      set stringMap [list \b " " \t " " \r \xB6 \n \xB6]
      set maxLength [expr {$maxLength + [string length $a] + 2}]
      set hostLength [lindex [getHostSize] 0]
      set valueLength [expr {$hostLength - $maxLength - 5}]; # " ... "

      foreach name $names {
        #
        # NOTE: Format the array element name for display.
        #
        set nameString [string map $stringMap [appendArgs $a ( $name )]]

        #
        # NOTE: If the value by itself is too long to fit on one host line,
        #       just truncate and ellipsis it.
        #
        set valueString [string map $stringMap $array($name)]

        if {[string length $valueString] > $valueLength} then {
          set valueString [appendArgs [string range $valueString 0 \
              [expr {$valueLength - 4}]] " ..."]
        }

        #
................................................................................
      }
    }
 
    proc findDirectories { pattern } {
      #
      # NOTE: Block non-Windows platforms since this is Windows specific.
      #
      if {![isWindows]} then {
        error "not supported on this operating system"
      }

      #
      # NOTE: This should work properly in Eagle only.
      #
      set dir ""; set result [list]
................................................................................
      return $result
    }
 
    proc findFiles { pattern } {
      #
      # NOTE: Block non-Windows platforms since this is Windows specific.
      #
      if {![isWindows]} then {
        error "not supported on this operating system"
      }

      #
      # NOTE: This should work properly in Eagle only.
      #
      set fileName ""; set result [list]
................................................................................
      return $result
    }
 
    proc findFilesRecursive { pattern } {
      #
      # NOTE: Block non-Windows platforms since this is Windows specific.
      #
      if {![isWindows]} then {
        error "not supported on this operating system"
      }

      #
      # NOTE: This should work properly in Eagle only.
      #
      set fileName ""; set result [list]
................................................................................
      return $result
    }
 
    proc findFilesRecursive { pattern } {
      #
      # NOTE: Block non-Windows platforms since this is Windows specific.
      #
      if {![isWindows]} then {
        error "not supported on this operating system"
      }

      #
      # NOTE: This should work properly in Tcl only.
      #
      set result [list]
................................................................................
    }
 
    #
    # NOTE: Exports the necessary commands from this package and import them
    #       into the global namespace.
    #
    exportAndImportPackageCommands [namespace current] [list \
        isEagle isWindows haveGaruda isTclThread isMono isSameFileName \
        getEnvironmentVariable combineFlags getCompileInfo getPlatformInfo \
        getPluginPath appendArgs lappendArgs getDictionaryValue \
        getColumnValue getRowColumnValue tqputs tqlog readFile \
        readSharedFile writeFile appendFile appendLogFile appendSharedFile \
        appendSharedLogFile readAsciiFile writeAsciiFile readUnicodeFile \
        writeUnicodeFile getDirResultPath addToPath removeFromPath execShell \
        lshuffle ldifference filter map reduce getLengthModifier debug \

Changes to Externals/Eagle/lib/Eagle1.0/test.eagle.

483
484
485
486
487
488
489
490
491
492
493








494
495
496
497
498
499
500
501







502
503
504
505
506
507
508












509
510












511
512
513
514
515
516
517
...
799
800
801
802
803
804
805
806






807
808
809






























































810
811
812
813
814
815
816
....
1078
1079
1080
1081
1082
1083
1084






1085
1086
1087
1088
1089
1090
1091
....
1300
1301
1302
1303
1304
1305
1306

1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319







1320
1321
1322
1323
1324
1325
1326
1327
1328
1329







1330
1331
1332
1333
1334
1335
1336
....
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396












1397
1398
1399
1400
1401
1402
1403
....
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414






1415
1416
1417
1418

1419
1420
1421
1422
1423
1424
1425
....
1494
1495
1496
1497
1498
1499
1500


1501
1502

1503


1504
1505
1506
1507
1508
1509
1510
....
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
....
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
....
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
....
2577
2578
2579
2580
2581
2582
2583












2584
2585
2586
2587
2588
2589
2590
....
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
2888
2889
2890
2891
2892

    #
    # TODO: Add more support for standard tcltest options here.
    #
    set options [list \
        -breakOnLeak -configuration -constraints -exitOnComplete -file \
        -logFile -machine -match -no -notFile -platform -postTest -preTest \
        -randomOrder -skip -startFile -stopFile -stopOnFailure -suffix \
        -suite -tclsh -threshold]

    foreach {name value} $args {








      #
      # NOTE: Use the [tqputs] command here just in case the test log file
      #       has not been setup yet (i.e. by default, this procedure is
      #       almost always called by the test prologue file prior to the
      #       test log file having been setup and we do not want to just
      #       lose this output).
      #
      if {[lsearch -exact $options $name] != -1} then {







        set array($name) $value

        tqputs $::test_channel [appendArgs \
            "---- overrode test option \"" $name "\" with value \"" \
            $value \"\n]
      } else {
        tqputs $::test_channel [appendArgs \












            "---- unknown test option \"" $name "\" with value \"" \
            $value "\" ignored\n"]












      }
    }

    #
    # NOTE: Now, attempt to flush the test log queue, if available.
    #
    tlog ""
................................................................................
    }
  }
 
  proc getTestLogId {} {
    return [expr {[info exists ::test_log_id] ? \
        [append result . $::test_log_id] : ""}]
  }
 






  proc getTestLog {} {
    return [expr {[info exists ::test_log] ? $::test_log : ""}]
  }






























































 
  proc getTestSuite {} {
    #
    # NOTE: Determine the effective test suite name and return it.  If the
    #       test suite name cannot be determined, return the default based
    #       on whether we are running in Eagle or native Tcl.
    #
................................................................................
  }
 
  proc isStopOnFailure {} {
    return [expr {[info exists ::test_stop_on_failure] && \
                  [string is boolean -strict $::test_stop_on_failure] && \
                  $::test_stop_on_failure}]
  }






 
  proc isExitOnComplete {} {
    return [expr {[info exists ::test_exit_on_complete] && \
                  [string is boolean -strict $::test_exit_on_complete] && \
                  $::test_exit_on_complete}]
  }
 
................................................................................
 
  proc recordTestStatistics { varName index } {
    #
    # NOTE: Record counts of all object types that we track.
    #
    upvar 1 $varName array


    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]]








    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: 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(connections,$index) 0
................................................................................
    #
    # NOTE: Show what leaked, if anything.
    #
    set count 0; upvar 1 $statsVarName array

    foreach statistic $statistics {
      if {$array($statistic,after) > $array($statistic,before)} then {
        incr count; lappend array(statistics,leaked) $statistic

        tputs $channel [appendArgs "==== \"" $fileName "\" LEAKED " \
            $statistic \n]

        if {[info exists array($statistic,before,list)]} then {
          tputs $channel [appendArgs "---- " $statistic " BEFORE: " \
              [formatList $array($statistic,before,list)] \n]
        }

        if {[info exists array($statistic,after,list)]} then {
          tputs $channel [appendArgs "---- " $statistic " AFTER: " \
              [formatList $array($statistic,after,list)] \n]
        }












      }
    }

    #
    # NOTE: Make sure this file name is recorded in the list of file names with
    #       leaking tests.
    #
................................................................................

    if {$count > 0 && \
        [lsearch -exact $fileNames [file tail $fileName]] == -1} then {
      lappend fileNames [file tail $fileName]
    }

    #
    # NOTE: If we are supposed to break into the debugger whenever a leak is
    #       detected, do it now.
    #






    if {$count > 0 && [isBreakOnLeak]} then {
      testDebugBreak
    }
  }

 
  proc formatList { list {default ""} {columns 1} } {
    if {[catch {
      set result ""
      set count 1

      foreach item $list {
................................................................................
    #
    # NOTE: Perform the inverse of [lsearch -glob], attempt
    #       to match an element against a list of patterns.
    #
    set command [list string match]
    if {$noCase} then {lappend command -nocase}



    for {set index 0} {$index < [llength $patterns]} {incr index} {
      set pattern [lindex $patterns $index]

      if {[eval $command [list $pattern] [list $element]]} then {return $index}


    }

    return -1
  }
 
  proc removePathFromFileNames { path fileNames } {
    set result [list]
................................................................................
          after flags =$flags
        }
      } finally {
        interp bgerror {} $bgerror
      }
    }
 
    proc testExecTclScript { script {shell ""} } {
      try {
        #
        # NOTE: Get a temporary file name for the script we are going to
        #       use to query the machine type for the native Tcl shell.
        #
        set fileName [file tempname]

................................................................................
              [string length $::test_tclsh] > 0} then {
            set shell $::test_tclsh
          } else {
            #
            # NOTE: We cannot execute the native Tcl shell because one
            #       has not been specified, nor configured.
            #
            return error
          }
        }

        #
        # NOTE: Evaluate the script using the native Tcl shell, trim the
        #       excess whitespace from the output, and return it to the
        #       caller.
................................................................................
          #
          return $result
        } else {
          #
          # NOTE: We could not execute the native Tcl shell (perhaps one
          #       is not available?).
          #
          return error
        }
      } finally {
        #
        # NOTE: Did we create a temporary file?
        #
        if {[info exists fileName] && \
            [string length $fileName] > 0 && \
................................................................................
    }
 
    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 {
................................................................................
    #
    exportAndImportPackageCommands [namespace current] [list \
        tputs tlog getSoftwareRegistryKey haveConstraint addConstraint \
        haveOrAddConstraint getConstraints removeConstraint fixConstraints \
        calculateBogoCops calculateRelativePerformance formatTimeStamp \
        formatElapsedTime sourceIfValid processTestArguments \
        getTclShellFileName getTemporaryPath getFiles getTestFiles \
        getTestRunId getTestLogId getTestLog getTestSuite getTestMachine \
        getTestPlatform getTestConfiguration getTestSuffix testExec \
        testClrExec execTestShell isRandomOrder isBreakOnLeak isStopOnFailure \

        isExitOnComplete returnInfoScript runTestPrologue runTestEpilogue \
        hookPuts unhookPuts runTest testDebugBreak testArrayGet testShim \
        tsource recordTestStatistics reportTestStatistics formatList \
        formatListAsDict pathToRegexp inverseLsearchGlob \
        removePathFromFileNames formatDecimal clearTestPercent \
        reportTestPercent runAllTests isTestSuiteRunning configureTcltest \

        machineToPlatform getPassPercentage getSkipPercentage] false false

    ###########################################################################
    ############################## END Tcl ONLY ###############################
    ###########################################################################
  }
 
  #
  # NOTE: Provide the Eagle test package to the interpreter.
  #
  package provide Eagle.Test \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}
 







|
|

|
>
>
>
>
>
>
>
>








>
>
>
>
>
>
>






|
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>







 








>
>
>
>
>
>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>







 







>













>
>
>
>
>
>
>










>
>
>
>
>
>
>







 







|













>
>
>
>
>
>
>
>
>
>
>
>







 







|
|

>
>
>
>
>
>
|



>







 







>
>
|

>
|
>
>







 







|







 







|







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>







 







|
|
|
>
|
|
|
<
|
|
>
|













483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
...
838
839
840
841
842
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
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
....
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
....
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
....
1504
1505
1506
1507
1508
1509
1510
1511
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
....
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
....
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
....
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
....
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
....
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
....
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
....
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040

3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057

    #
    # TODO: Add more support for standard tcltest options here.
    #
    set options [list \
        -breakOnLeak -configuration -constraints -exitOnComplete -file \
        -logFile -machine -match -no -notFile -platform -postTest -preTest \
        -randomOrder -skip -startFile -stopFile -stopOnFailure -stopOnLeak \
        -suffix -suite -tclsh -threshold]

    set length [llength $args]

    for {set index 0} {$index < $length} {incr index} {
      #
      # NOTE: Grab the current list element, which should be the name of
      #       the test option.
      #
      set name [lindex $args $index]

      #
      # NOTE: Use the [tqputs] command here just in case the test log file
      #       has not been setup yet (i.e. by default, this procedure is
      #       almost always called by the test prologue file prior to the
      #       test log file having been setup and we do not want to just
      #       lose this output).
      #
      if {[lsearch -exact $options $name] != -1} then {
        #
        # NOTE: Is there another list element available for the value?  If
        #       not, this is not a valid test option.
        #
        if {$index + 1 < $length} then {
          incr index; set value [lindex $args $index]

          set array($name) $value

          tqputs $::test_channel [appendArgs \
              "---- overrode test option \"" $name "\" with value \"" \
              $value \"\n]
        } else {
          tqputs $::test_channel [appendArgs \
              "---- no value for test option \"" $name "\", ignored\n"]
        }
      } elseif {[string index $name 0] eq "-"} then {
        #
        # NOTE: Is there another list element available for the value?  If
        #       not, it does not conform to the standard command line name
        #       and value pattern.
        #
        if {$index + 1 < $length} then {
          incr index; set value [lindex $args $index]

          tqputs $::test_channel [appendArgs \
              "---- unknown test option \"" $name "\" with value \"" \
              $value "\" ignored\n"]
        } else {
          tqputs $::test_channel [appendArgs \
              "---- no value for unknown test option \"" $name \
              "\" ignored\n"]
        }
      } else {
        #
        # NOTE: This is not an option of *any* kind that we know about.
        #       Ignore it and issue a warning.
        #
        tqputs $::test_channel [appendArgs \
            "---- unknown argument \"" $name "\" ignored\n"]
      }
    }

    #
    # NOTE: Now, attempt to flush the test log queue, if available.
    #
    tlog ""
................................................................................
    }
  }
 
  proc getTestLogId {} {
    return [expr {[info exists ::test_log_id] ? \
        [append result . $::test_log_id] : ""}]
  }
 
  proc getDefaultTestLog {} {
    return [file join [getTemporaryPath] [appendArgs \
        [file tail [info nameofexecutable]] [getTestLogId] \
        .test. [pid] .log]]
  }
 
  proc getTestLog {} {
    return [expr {[info exists ::test_log] ? $::test_log : ""}]
  }
 
  proc getLastTestLog {} {
    #
    # NOTE: Use the configured log file name -OR- what the configured
    #       log file name would be, by default, if it actually existed.
    #
    if {[info exists ::test_log]} then {
      set logFileName $::test_log
    } else {
      set logFileName [getDefaultTestLog]
    }

    set logFileName [file normalize $logFileName]
    set logTime [expr {[file exists $logFileName] ? \
        [file mtime $logFileName] : 0}]

    #
    # NOTE: Make the log file name into a pattern we can use to find
    #       the related log files.
    #
    if {[regsub -- {\.\d+\.} $logFileName {.*.} pattern]} then {
      set lastLogFile [list]

      foreach fileName [findFiles $pattern] {
        #
        # NOTE: Skip the current test log file, if found.
        #
        if {[isSameFileName $fileName $logFileName]} then {
          continue
        }

        #
        # NOTE: When was this log file last modified?
        #
        set time [file mtime $fileName]

        #
        # NOTE: Check if there has been no log file seen -OR- this
        #       log file has the latest modified time seen.
        #
        if {[llength $lastLogFile] == 0 || \
            $time > [lindex $lastLogFile 0]} then {
          #
          # NOTE: This is now the latest log file seen.
          #
          set lastLogFile [list $time $fileName]
        }
      }

      #
      # NOTE: Either return the last log file seen, if any -OR- the
      #       configured log file, if it actually exists.
      #
      if {[llength $lastLogFile] > 0} then {
        return [lindex $lastLogFile 1]
      } elseif {$logTime != 0} then {
        return $logFileName
      }
    }

    return ""
  }
 
  proc getTestSuite {} {
    #
    # NOTE: Determine the effective test suite name and return it.  If the
    #       test suite name cannot be determined, return the default based
    #       on whether we are running in Eagle or native Tcl.
    #
................................................................................
  }
 
  proc isStopOnFailure {} {
    return [expr {[info exists ::test_stop_on_failure] && \
                  [string is boolean -strict $::test_stop_on_failure] && \
                  $::test_stop_on_failure}]
  }
 
  proc isStopOnLeak {} {
    return [expr {[info exists ::test_stop_on_leak] && \
                  [string is boolean -strict $::test_stop_on_leak] && \
                  $::test_stop_on_leak}]
  }
 
  proc isExitOnComplete {} {
    return [expr {[info exists ::test_exit_on_complete] && \
                  [string is boolean -strict $::test_exit_on_complete] && \
                  $::test_exit_on_complete}]
  }
 
................................................................................
 
  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.
      #
      set array(connections,$index) 0
................................................................................
    #
    # NOTE: Show what leaked, if anything.
    #
    set count 0; upvar 1 $statsVarName array

    foreach statistic $statistics {
      if {$array($statistic,after) > $array($statistic,before)} then {
        lappend array(statistics,leaked) $statistic

        tputs $channel [appendArgs "==== \"" $fileName "\" LEAKED " \
            $statistic \n]

        if {[info exists array($statistic,before,list)]} then {
          tputs $channel [appendArgs "---- " $statistic " BEFORE: " \
              [formatList $array($statistic,before,list)] \n]
        }

        if {[info exists array($statistic,after,list)]} then {
          tputs $channel [appendArgs "---- " $statistic " AFTER: " \
              [formatList $array($statistic,after,list)] \n]
        }

        if {[info exists array(uncounted,before)] && \
            [lsearch -exact $array(uncounted,before) $statistic] != -1} then {
          continue
        }

        if {[info exists array(uncounted,after)] && \
            [lsearch -exact $array(uncounted,after) $statistic] != -1} then {
          continue
        }

        incr count
      }
    }

    #
    # NOTE: Make sure this file name is recorded in the list of file names with
    #       leaking tests.
    #
................................................................................

    if {$count > 0 && \
        [lsearch -exact $fileNames [file tail $fileName]] == -1} then {
      lappend fileNames [file tail $fileName]
    }

    #
    # NOTE: If we are supposed to stop or break into the debugger whenever
    #       a leak is detected, do it now.
    #
    if {$count > 0} then {
      if {[isStopOnLeak]} then {
        tresult Error "OVERALL RESULT: STOP-ON-LEAK\n"

        unset -nocomplain ::test_suite_running
        error ""; # no message
      } elseif {[isBreakOnLeak]} then {
        testDebugBreak
      }
    }
  }
 
  proc formatList { list {default ""} {columns 1} } {
    if {[catch {
      set result ""
      set count 1

      foreach item $list {
................................................................................
    #
    # NOTE: Perform the inverse of [lsearch -glob], attempt
    #       to match an element against a list of patterns.
    #
    set command [list string match]
    if {$noCase} then {lappend command -nocase}

    set length [llength $patterns]

    for {set index 0} {$index < $length} {incr index} {
      set pattern [lindex $patterns $index]

      if {[eval $command [list $pattern] [list $element]]} then {
        return $index
      }
    }

    return -1
  }
 
  proc removePathFromFileNames { path fileNames } {
    set result [list]
................................................................................
          after flags =$flags
        }
      } finally {
        interp bgerror {} $bgerror
      }
    }
 
    proc testExecTclScript { script {shell ""} {verbose false} } {
      try {
        #
        # NOTE: Get a temporary file name for the script we are going to
        #       use to query the machine type for the native Tcl shell.
        #
        set fileName [file tempname]

................................................................................
              [string length $::test_tclsh] > 0} then {
            set shell $::test_tclsh
          } else {
            #
            # NOTE: We cannot execute the native Tcl shell because one
            #       has not been specified, nor configured.
            #
            return [expr {$verbose ? "::test_tclsh missing" : "error"}]
          }
        }

        #
        # NOTE: Evaluate the script using the native Tcl shell, trim the
        #       excess whitespace from the output, and return it to the
        #       caller.
................................................................................
          #
          return $result
        } else {
          #
          # NOTE: We could not execute the native Tcl shell (perhaps one
          #       is not available?).
          #
          return [expr {$verbose ? [appendArgs "error: " $result] : "error"}]
        }
      } finally {
        #
        # NOTE: Did we create a temporary file?
        #
        if {[info exists fileName] && \
            [string length $fileName] > 0 && \
................................................................................
    }
 
    proc getTkVersionForTclShell { {shell ""} } {
      return [testExecTclScript {
        puts -nonewline stdout [package require Tk]; exit
      } $shell]
    }
 
    proc evalWithTclShell { script {raw false} {shell ""} {verbose false} } {
      return [testExecTclScript [string map \
          [list %script% $script %raw% $raw] {
        if {%raw%} then {
          set code [catch {%script%} result]
          puts -nonewline stdout [list $code $result]
        } else {
          puts -nonewline stdout [eval {%script%}]
        }
      }] $shell $verbose]
    }
 
    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 {
................................................................................
    #
    exportAndImportPackageCommands [namespace current] [list \
        tputs tlog getSoftwareRegistryKey haveConstraint addConstraint \
        haveOrAddConstraint getConstraints removeConstraint fixConstraints \
        calculateBogoCops calculateRelativePerformance formatTimeStamp \
        formatElapsedTime sourceIfValid processTestArguments \
        getTclShellFileName getTemporaryPath getFiles getTestFiles \
        getTestRunId getTestLogId getDefaultTestLog getTestLog getLastTestLog \
        getTestSuite getTestMachine getTestPlatform getTestConfiguration \
        getTestSuffix testExec testClrExec execTestShell isRandomOrder \
        isBreakOnLeak isStopOnFailure isStopOnLeak isExitOnComplete \
        returnInfoScript runTestPrologue runTestEpilogue hookPuts unhookPuts \
        runTest testDebugBreak testArrayGet testShim tsource \
        recordTestStatistics reportTestStatistics formatList formatListAsDict \

        pathToRegexp inverseLsearchGlob removePathFromFileNames formatDecimal \
        clearTestPercent reportTestPercent runAllTests isTestSuiteRunning \
        configureTcltest machineToPlatform getPassPercentage \
        getSkipPercentage] false false

    ###########################################################################
    ############################## END Tcl ONLY ###############################
    ###########################################################################
  }
 
  #
  # NOTE: Provide the Eagle test package to the interpreter.
  #
  package provide Eagle.Test \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}
 

Changes to Externals/Eagle/lib/Test1.0/constraints.eagle.

244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260

261

262

263
264
265
266
267
268


269
270
271
272
273
274
275
...
767
768
769
770
771
772
773


774
775
776
777
778
779
780
781
782
...
789
790
791
792
793
794
795
796
797
798
799
800

801
802
803
804
805
806
807
...
814
815
816
817
818
819
820
821
822

823
824
825
826
827
828
829
830
831
832
833
834
...
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
...
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
...
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
....
1250
1251
1252
1253
1254
1255
1256















1257
1258
1259
1260
1261
1262
1263
....
1393
1394
1395
1396
1397
1398
1399















1400
1401
1402
1403
1404
1405
1406
....
2035
2036
2037
2038
2039
2040
2041





























2042
2043
2044
2045
2046
2047
2048
....
2059
2060
2061
2062
2063
2064
2065

2066

2067

2068
2069
2070
2071
2072
2073
2074
....
2181
2182
2183
2184
2185
2186
2187
2188

2189
2190


2191
2192
2193
2194
2195
2196
2197

2198

2199

2200
2201
2202

2203
2204
2205
2206
2207
2208
2209
....
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
    ###########################################################################

    if {![isEagle]} then {
      #
      # BUGFIX: We do not normally want to skip any Mono bugs in native Tcl.
      #
      if {![info exists ::no(runtimeVersion)]} then {
        set constraints [list monoToDo monoBug monoCrash]

        #
        # NOTE: Add the necessary constraints for each version of Mono that
        #       we know about.
        #
        foreach monoVersion [getKnownMonoVersions] {
          set constraintVersion [join $monoVersion ""]

          addConstraint [appendArgs monoToDo $constraintVersion]

          addConstraint [appendArgs monoBug $constraintVersion]

          addConstraint [appendArgs monoCrash $constraintVersion]

        }

        #
        # NOTE: Also add just the generic Mono constraints that do not have
        #       a trailing version.
        #


        foreach constraint $constraints {
          addConstraint $constraint
        }
      }
    }
  }
 
................................................................................
      #
      if {$::tcl_version eq "8.4"} then {
        #
        # NOTE: Baseline reported language and feature
        #       version.
        #
        addConstraint tcl84


        addConstraint tcl84OrHigher
        addConstraint tcl84Feature

        if {[isEagle]} then {
          #
          # NOTE: *EAGLE* We do want to include any
          #       tests that target "Tcl 8.5 or higher"
          #       features and/or "Tcl 8.6 or higher"
          #       features because they would not be in
................................................................................
        }
      } elseif {$::tcl_version eq "8.5"} then {
        #
        # NOTE: Baseline reported language and feature
        #       version.  Tcl 8.5 includes all the
        #       features from itself and Tcl 8.4.
        #
        addConstraint tcl85
        addConstraint tcl84OrHigher
        addConstraint tcl85OrHigher
        addConstraint tcl84Feature
        addConstraint tcl85Feature


        if {[isEagle]} then {
          #
          # NOTE: *EAGLE* We do want to include any
          #       tests that target "Tcl 8.5 or higher"
          #       features and/or "Tcl 8.6 or higher"
          #       features because they would not be in
................................................................................
      } elseif {$::tcl_version eq "8.6"} then {
        #
        # NOTE: Baseline reported language and feature
        #       version.  Tcl 8.6 includes all the
        #       features from itself Tcl 8.4, and Tcl
        #       8.5.
        #
        addConstraint tcl86
        addConstraint tcl84OrHigher

        addConstraint tcl85OrHigher
        addConstraint tcl86OrHigher
        addConstraint tcl84Feature
        addConstraint tcl85Feature
        addConstraint tcl86Feature
      }

      tputs $channel [appendArgs $::tcl_version \n]
    } else {
      tputs $channel no\n
    }
  }
................................................................................

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForNamespaces { channel } {
    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).
      #
................................................................................
        } 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 {$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"
................................................................................
      addConstraint namespaces.available
      addConstraint namespaces

      tputs $channel enabled\n
    }
  }
 
  proc checkForTestExec { channel } {
    tputs $channel "---- checking for test use of \"exec\" command... "

    set procName [lindex [info level [info level]] 0]

    if {![info exists ::no(testExec)] && [canTestExec $procName]} then {
      addConstraint testExec

      tputs $channel yes\n

      if {[info exists ::no(exec)]} then {
        tputs $channel \
            "==== WARNING: running with the \"testExec\" procedure disabled\n"
      }
    } else {
      tputs $channel no\n
    }
  }
................................................................................
      addConstraint tip426

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }















 
  proc checkForTiming {
          channel threshold {constraint ""} {tries 1} {delay 1000}
          {average false} {asynchronous false} } {
    tputs $channel [appendArgs \
        "---- checking for precision timing (threshold of " $threshold \
        " milliseconds" [expr {$average ? " average" : ""}] ", delay of " \
................................................................................

        tputs $channel yes\n
      }
    } else {
      tputs $channel no\n
    }
  }















 
  proc checkForStackIntensive { channel } {
    tputs $channel "---- checking for stack intensive testing... "

    #
    # NOTE: Are we allowed to do stack intensive testing?
    #
................................................................................
              set constraintVersion [join $monoVersion ""]

              addConstraint [appendArgs mono $constraintVersion OrHigher]
              addConstraint [appendArgs monoToDo $constraintVersion]
              addConstraint [appendArgs monoBug $constraintVersion]
              addConstraint [appendArgs monoCrash $constraintVersion]
            }





























          }
        } else {
          #
          # NOTE: If the runtime version was found, add a test constraint
          #       for it now.
          #
          if {[string length $version] > 0} then {
................................................................................
          #       necessary constraints for each version of Mono we know
          #       about.
          #
          foreach monoVersion [getKnownMonoVersions] {
            set constraintVersion [join $monoVersion ""]

            addConstraint [appendArgs monoToDo $constraintVersion]

            addConstraint [appendArgs monoBug $constraintVersion]

            addConstraint [appendArgs monoCrash $constraintVersion]

          }
        }

        tputs $channel [appendArgs $::eagle_platform(runtimeVersion) \
            " " ( $dotVersion ) \n]
      } else {
        tputs $channel no\n
................................................................................

        tputs $channel [appendArgs $culture \n]
      } else {
        tputs $channel unknown\n
      }
    }
 
    proc checkForQuiet { channel } {

      tputs $channel "---- checking for quiet... "



      if {[catch {object invoke Interpreter.GetActive Quiet} quiet] == 0 && \
          $quiet} then {
        #
        # NOTE: Yes, quiet mode is enabled.
        #
        addConstraint quiet


        tputs $channel yes\n

      } else {

        tputs $channel no\n
      }
    }

 
    proc checkForReferenceCountTracking { channel } {
      tputs $channel "---- checking for object reference count tracking... "

      if {[info exists ::eagle_platform(compileOptions)] && \
          ([lsearch -exact -nocase $::eagle_platform(compileOptions) \
              NOTIFY] != -1 || \
................................................................................
        checkForTclOptions checkForWindowsCommandProcessor checkForFossil \
        checkForEagle checkForSymbols checkForLogFile checkForGaruda \
        checkForShell checkForDebug checkForTk checkForVersion \
        checkForCommand checkForNamespaces checkForTestExec \
        checkForTestMachine checkForTestPlatform checkForTestConfiguration \
        checkForTestSuffix checkForFile checkForPathFile checkForNativeCode \
        checkForTip127 checkForTip194 checkForTip207 checkForTip241 \
        checkForTip285 checkForTip405 checkForTip426 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"}]
}
 







<
<








>

>

>






>
>







 







>
>

|







 







|

|
|
|
>







 







|

>

|
|
|
|







 







|







 







|







 







|









|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>

>

>







 







|
>
|
|
>
>
|
|





>
|
>

>



>







 







|
|
|
|
|













244
245
246
247
248
249
250


251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
...
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
...
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
...
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
...
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
...
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
...
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
....
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
....
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
....
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
....
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
....
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
....
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
    ###########################################################################

    if {![isEagle]} then {
      #
      # BUGFIX: We do not normally want to skip any Mono bugs in native Tcl.
      #
      if {![info exists ::no(runtimeVersion)]} then {


        #
        # NOTE: Add the necessary constraints for each version of Mono that
        #       we know about.
        #
        foreach monoVersion [getKnownMonoVersions] {
          set constraintVersion [join $monoVersion ""]

          addConstraint [appendArgs monoToDo $constraintVersion]
          addConstraint [appendArgs monoToDo $constraintVersion Only]
          addConstraint [appendArgs monoBug $constraintVersion]
          addConstraint [appendArgs monoBug $constraintVersion Only]
          addConstraint [appendArgs monoCrash $constraintVersion]
          addConstraint [appendArgs monoCrash $constraintVersion Only]
        }

        #
        # NOTE: Also add just the generic Mono constraints that do not have
        #       a trailing version.
        #
        set constraints [list monoToDo monoBug monoCrash]

        foreach constraint $constraints {
          addConstraint $constraint
        }
      }
    }
  }
 
................................................................................
      #
      if {$::tcl_version eq "8.4"} then {
        #
        # NOTE: Baseline reported language and feature
        #       version.
        #
        addConstraint tcl84
        addConstraint tcl84Feature
        addConstraint tcl84OrLower
        addConstraint tcl84OrHigher
        addConstraint tcl85OrLower

        if {[isEagle]} then {
          #
          # NOTE: *EAGLE* We do want to include any
          #       tests that target "Tcl 8.5 or higher"
          #       features and/or "Tcl 8.6 or higher"
          #       features because they would not be in
................................................................................
        }
      } elseif {$::tcl_version eq "8.5"} then {
        #
        # NOTE: Baseline reported language and feature
        #       version.  Tcl 8.5 includes all the
        #       features from itself and Tcl 8.4.
        #
        addConstraint tcl84Feature
        addConstraint tcl84OrHigher
        addConstraint tcl85
        addConstraint tcl85Feature
        addConstraint tcl85OrLower
        addConstraint tcl85OrHigher

        if {[isEagle]} then {
          #
          # NOTE: *EAGLE* We do want to include any
          #       tests that target "Tcl 8.5 or higher"
          #       features and/or "Tcl 8.6 or higher"
          #       features because they would not be in
................................................................................
      } elseif {$::tcl_version eq "8.6"} then {
        #
        # NOTE: Baseline reported language and feature
        #       version.  Tcl 8.6 includes all the
        #       features from itself Tcl 8.4, and Tcl
        #       8.5.
        #
        addConstraint tcl84Feature
        addConstraint tcl84OrHigher
        addConstraint tcl85Feature
        addConstraint tcl85OrHigher
        addConstraint tcl86
        addConstraint tcl86Feature
        addConstraint tcl86OrLower
        addConstraint tcl86OrHigher
      }

      tputs $channel [appendArgs $::tcl_version \n]
    } else {
      tputs $channel no\n
    }
  }
................................................................................

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForNamespaces { channel quiet } {
    tputs $channel "---- checking for namespace support... "

    if {[isEagle]} then {
      #
      # NOTE: Check if namespace support was compiled into the core library
      #       (i.e. this is beta 30 or later).
      #
................................................................................
        } 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"
................................................................................
      addConstraint namespaces.available
      addConstraint namespaces

      tputs $channel enabled\n
    }
  }
 
  proc checkForTestExec { channel quiet } {
    tputs $channel "---- checking for test use of \"exec\" command... "

    set procName [lindex [info level [info level]] 0]

    if {![info exists ::no(testExec)] && [canTestExec $procName]} then {
      addConstraint testExec

      tputs $channel yes\n

      if {!$quiet && [info exists ::no(exec)]} then {
        tputs $channel \
            "==== WARNING: running with the \"testExec\" procedure disabled\n"
      }
    } else {
      tputs $channel no\n
    }
  }
................................................................................
      addConstraint tip426

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForTip429 { channel } {
    tputs $channel "---- checking for TIP #429... "

    #
    # NOTE: Is the interpreter TIP #429 ready?
    #
    if {[catch {string cat}] == 0} then {
      addConstraint tip429

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForTiming {
          channel threshold {constraint ""} {tries 1} {delay 1000}
          {average false} {asynchronous false} } {
    tputs $channel [appendArgs \
        "---- checking for precision timing (threshold of " $threshold \
        " milliseconds" [expr {$average ? " average" : ""}] ", delay of " \
................................................................................

        tputs $channel yes\n
      }
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForMemoryIntensive { channel } {
    tputs $channel "---- checking for memory intensive testing... "

    #
    # NOTE: Are we allowed to do memory intensive testing?
    #
    if {![info exists ::no(memoryIntensive)]} then {
      addConstraint memoryIntensive

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForStackIntensive { channel } {
    tputs $channel "---- checking for stack intensive testing... "

    #
    # NOTE: Are we allowed to do stack intensive testing?
    #
................................................................................
              set constraintVersion [join $monoVersion ""]

              addConstraint [appendArgs mono $constraintVersion OrHigher]
              addConstraint [appendArgs monoToDo $constraintVersion]
              addConstraint [appendArgs monoBug $constraintVersion]
              addConstraint [appendArgs monoCrash $constraintVersion]
            }

            #
            # NOTE: Check all known versions of Mono for an exact match with
            #       the currently running one.
            #
            foreach monoVersion [getKnownMonoVersions] {
              #
              # NOTE: Check if Mono major/minor version is exactly the one
              #       we are currently processing.
              #
              set constraintVersion [join $monoVersion ""]

              if {[lindex $monoVersion 0] == $majorVersion && \
                  [lindex $monoVersion 1] == $minorVersion} then {
                #
                # NOTE: Add test constraints that only apply to this exact
                #       version of Mono.
                #
                addConstraint [appendArgs mono $constraintVersion Only]
              } else {
                #
                # NOTE: Add test constraints that apply to all versions of
                #       Mono except this exact version.
                #
                addConstraint [appendArgs monoToDo $constraintVersion Only]
                addConstraint [appendArgs monoBug $constraintVersion Only]
                addConstraint [appendArgs monoCrash $constraintVersion Only]
              }
            }
          }
        } else {
          #
          # NOTE: If the runtime version was found, add a test constraint
          #       for it now.
          #
          if {[string length $version] > 0} then {
................................................................................
          #       necessary constraints for each version of Mono we know
          #       about.
          #
          foreach monoVersion [getKnownMonoVersions] {
            set constraintVersion [join $monoVersion ""]

            addConstraint [appendArgs monoToDo $constraintVersion]
            addConstraint [appendArgs monoToDo $constraintVersion Only]
            addConstraint [appendArgs monoBug $constraintVersion]
            addConstraint [appendArgs monoBug $constraintVersion Only]
            addConstraint [appendArgs monoCrash $constraintVersion]
            addConstraint [appendArgs monoCrash $constraintVersion Only]
          }
        }

        tputs $channel [appendArgs $::eagle_platform(runtimeVersion) \
            " " ( $dotVersion ) \n]
      } else {
        tputs $channel no\n
................................................................................

        tputs $channel [appendArgs $culture \n]
      } else {
        tputs $channel unknown\n
      }
    }
 
    proc checkForQuiet { channel quiet } {
      if {!$quiet} then {
        tputs $channel "---- checking for quiet... "
      }

      if {[catch {
        object invoke Interpreter.GetActive Quiet
      } isQuiet] == 0 && $isQuiet} then {
        #
        # NOTE: Yes, quiet mode is enabled.
        #
        addConstraint quiet

        if {!$quiet} then {
          tputs $channel yes\n
        }
      } else {
        if {!$quiet} then {
          tputs $channel no\n
        }
      }
    }
 
    proc checkForReferenceCountTracking { channel } {
      tputs $channel "---- checking for object reference count tracking... "

      if {[info exists ::eagle_platform(compileOptions)] && \
          ([lsearch -exact -nocase $::eagle_platform(compileOptions) \
              NOTIFY] != -1 || \
................................................................................
        checkForTclOptions checkForWindowsCommandProcessor checkForFossil \
        checkForEagle checkForSymbols checkForLogFile checkForGaruda \
        checkForShell checkForDebug checkForTk checkForVersion \
        checkForCommand checkForNamespaces checkForTestExec \
        checkForTestMachine checkForTestPlatform checkForTestConfiguration \
        checkForTestSuffix checkForFile checkForPathFile checkForNativeCode \
        checkForTip127 checkForTip194 checkForTip207 checkForTip241 \
        checkForTip285 checkForTip405 checkForTip426 checkForTip429 \
        checkForTiming checkForPerformance checkForBigLists \
        checkForMemoryIntensive checkForStackIntensive checkForInteractive \
        checkForInteractiveCommand checkForUserInteraction checkForNetwork \
        checkForCompileOption checkForKnownCompileOptions] false false

    ###########################################################################
    ############################## END Tcl ONLY ###############################
    ###########################################################################
  }
 
  #
  # NOTE: Provide the Eagle test constraints package to the interpreter.
  #
  package provide Eagle.Test.Constraints \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}
 

Changes to Externals/Eagle/lib/Test1.0/prologue.eagle.

89
90
91
92
93
94
95














96
97
98
99
100
101
102
...
282
283
284
285
286
287
288

289
290
291
292
293
294
295
...
350
351
352
353
354
355
356









357
358
359
360
361
362
363
...
414
415
416
417
418
419
420
421
422
423
424
























425
426
427
428
429
430
431
...
449
450
451
452
453
454
455
456

457
458
459
460
461
462
463
...
475
476
477
478
479
480
481
482

483
484
485
486
487
488
489
...
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
...
693
694
695
696
697
698
699





700
701
702
703
704
705
706
...
741
742
743
744
745
746
747



748
749
750
751
752
753
754
...
774
775
776
777
778
779
780




781
782
783
784
785
786
787
...
792
793
794
795
796
797
798




















































































799
800
801
802
803
804
805
....
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
....
1514
1515
1516
1517
1518
1519
1520


















1521
1522
1523
1524
1525
1526
1527
....
1584
1585
1586
1587
1588
1589
1590






1591
1592
1593
1594
1595
1596
1597
....
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
....
2329
2330
2331
2332
2333
2334
2335




2336
2337
2338
2339
2340
2341
2342
....
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
....
2454
2455
2456
2457
2458
2459
2460




2461
2462
2463
2464
2465
2466
2467
....
2478
2479
2480
2481
2482
2483
2484







2485
2486

2487
2488
2489
2490
2491
2492
2493
    }

    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]
  }
................................................................................
  set test_flags(-skip) [list]; # default to skipping no tests.
  set test_flags(-constraints) [list]; # default to no manual constraints.
  set test_flags(-logFile) ""; # default to using standard log file naming.
  set test_flags(-threshold) ""; # default to requiring all tests to pass.
  set test_flags(-randomOrder) ""; # default to deterministic order.
  set test_flags(-breakOnLeak) ""; # default to continue on leak.
  set test_flags(-stopOnFailure) ""; # default to continue on failure.

  set test_flags(-exitOnComplete) ""; # default to not exit after complete.
  set test_flags(-preTest) ""; # default to not evaluating anything.
  set test_flags(-postTest) ""; # default to not evaluating anything.
  set test_flags(-tclsh) ""; # Tcl shell, default to empty.

  #
  # NOTE: Check for and process any command line arguments.
................................................................................
        [string is boolean -strict $test_flags(-stopOnFailure)]} then {
      #
      # NOTE: Set the test stop-on-failure flag to the one provided by the
      #       command line.
      #
      set test_stop_on_failure $test_flags(-stopOnFailure)
    }










    if {[info exists test_flags(-exitOnComplete)] && \
        [string is boolean -strict $test_flags(-exitOnComplete)]} then {
      #
      # NOTE: Set the test exit-on-complete flag to the one provided by the
      #       command line.
      #
................................................................................
  # NOTE: Has automatic log file naming been disabled?
  #
  if {![info exists no(logFileName)]} then {
    #
    # NOTE: Set the log to use for test output, if necessary.
    #
    if {![info exists test_log]} then {
      set test_log [file join [getTemporaryPath] [appendArgs [file tail [info \
          nameofexecutable]] [getTestLogId] .test. [pid] .log]]
    }
  }

























  #
  # NOTE: Has native Tcl shell detection and use been disabled?
  #
  if {![info exists no(tclsh)]} then {
    #
    # NOTE: Set the Tcl shell executable to use for those specialized
................................................................................
        } 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"
            }

            set test_tclsh [getTclShellFileName true]
          } else {
            #
................................................................................
  #
  # NOTE: When running in Eagle, check for any non-core plugins loaded into
  #       the interpreter and issue warnings if any are found.  The warning
  #       may be used to explain subsequent test failures due to the extra
  #       plugins being loaded (i.e. there are some tests are sensitive to
  #       having "unexpected" plugins loaded).
  #
  if {[isEagle] && ![info exists no(warningForPlugin)]} then {

    foreach loaded [info loaded] {
      #
      # HACK: This code assumes that all plugins in the "Eagle._Plugins"
      #       namespace belong to the Eagle core library itself.
      #
      if {![string match Eagle._Plugins.* [lindex $loaded 1]]} then {
        tputs $test_channel [appendArgs \
................................................................................
      [expr {[info exists test_configuration] ? \
          $test_configuration : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- test suffix: " \
      [expr {[info exists test_suffix] ? \
          $test_suffix : "<none>"}] \n]

  if {[isEagle] && ![info exists no(warningForStrongName)]} then {
    catch {info engine PublicKeyToken} publicKeyToken

    if {[string length $publicKeyToken] == 0} then {
      #
      # NOTE: The Eagle core library is not strong name signed.  This is not an
      #       error, per se; however, it may cause some tests to fail and it
      #       should be reported to the user and noted in the test suite log
      #       file.
      #
      tputs $test_channel \
          "==== WARNING: running without any strong name signature...\n"
    } else {
      #
      # BUGBUG: Tcl 8.4 does not like this expression because it contains the
      #         "ni" operator (and Tcl tries to compile it even though it will
      #         only actually ever be evaluated in Eagle).
      #
      set expr {$publicKeyToken ni \
          "29c6297630be05eb 1e22ec67879739a2 358030063a832bc3"}

      if {[expr $expr]} then {
        #
        # NOTE: The Eagle core library is strong name signed with a key that is
        #       not official.  This is also not an error, per se; however, it
        #       may cause some tests to fail and it should be reported to the
        #       user and noted in the test suite log file.
        #
        tputs $test_channel [appendArgs \
            "==== WARNING: running without official strong name signature: " \
            $publicKeyToken \n]
      }

      unset expr
    }

    unset publicKeyToken

    tputs $test_channel [appendArgs "---- original command line: " \
        [info cmdline] \n]

    tputs $test_channel [appendArgs "---- threadId: " \
        [info tid] \n]

    tputs $test_channel [appendArgs "---- processors: " \
................................................................................
          [string is boolean -strict $test_break_on_leak] ? \
              $test_break_on_leak : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- stop on failure: " \
      [expr {[info exists test_stop_on_failure] && \
          [string is boolean -strict $test_stop_on_failure] ? \
              $test_stop_on_failure : "<none>"}] \n]






  tputs $test_channel [appendArgs "---- exit on complete: " \
      [expr {[info exists test_exit_on_complete] && \
          [string is boolean -strict $test_exit_on_complete] ? \
              $test_exit_on_complete : "<none>"}] \n]

  #
................................................................................

  tputs $test_channel [appendArgs "---- path: " \
      [expr {[info exists path] && [string length $path] > 0 ? \
          [appendArgs \" $path \"] : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- base path: \"" \
      $base_path \"\n]




  tputs $test_channel [appendArgs "---- root path: \"" \
      $root_path \"\n]

  tputs $test_channel [appendArgs "---- binary path: \"" \
      $bin_path \"\n]

................................................................................
  tputs $test_channel [appendArgs "---- disabled options: " \
      [formatList [lsort [array names no]] <none>] \n]

  #
  # NOTE: Initialize the Eagle test constraints.
  #
  if {[isEagle]} then {




    initializeTests; configureTcltest [list] [list] [list] [list] false

    #
    # NOTE: If the "no(mono)" variable is set (to anything) then any
    #       special test suite hacks for Mono will be disabled. This
    #       does not control or change any hacks for Mono that may
    #       be present in the library itself.
................................................................................

    ###########################################################################
    ######################### BEGIN Eagle Constraints #########################
    ###########################################################################

    tputs $test_channel \
        "---- start of Eagle specific test constraints...\n"





















































































    #
    # NOTE: Has administrator detection support been disabled?  We do
    #       this check [nearly] first as it may [eventually] be used
    #       to help determine if other constraints should be skipped.
    #
    if {![info exists no(administrator)]} then {
................................................................................
    #
    # NOTE: Has symbol testing support been disabled?
    #
    if {![info exists no(assemblySymbols)]} then {
      checkForSymbols $test_channel [lindex [info assembly] end]
    }

    #
    # NOTE: Has quiet testing support been disabled?
    #
    if {![info exists no(quiet)]} then {
      #
      # NOTE: For tests "basic-1.36", "debug-1.3", "debug-1.4", "object-10.*",
      #       and "perf-2.2".
      #
      checkForQuiet $test_channel
    }

    #
    # NOTE: Has object handle reference count tracking support been disabled
    #       (at compile-time)?
    #
    if {![info exists no(refCount)]} then {
      #
      # NOTE: For tests "excel-*", "object-2.*", "object-7.1", "object-8.*",
................................................................................
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestSetVariableLinks*

        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestUnsetVariableLinks*
      }



















      #
      # NOTE: Has field testing support been disabled?
      #
      if {![info exists no(testFields)]} then {
        #
        # NOTE: For tests "basic-1.39", "basic-1.40", "basic-1.41",
        #       "basic-1.42", and "basic-1.43".
................................................................................

        #
        # NOTE: For test "object-2.1".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestComplexMethod*







        #
        # NOTE: For test "object-2.3".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestToHexadecimalString*

        checkForObjectMember $test_channel Eagle._Tests.Default \
................................................................................
    checkForTestSuiteFiles $test_channel
  }

  #
  # NOTE: Has all use of [exec] for tests been disabled?
  #
  if {![info exists no(checkForTestExec)]} then {
    checkForTestExec $test_channel
  }

  #
  # NOTE: Has checking for the test machine been disabled?
  #
  if {![info exists no(testMachine)]} then {
    checkForTestMachine $test_channel
................................................................................
  if {![info exists no(tclOptions)]} then {
    checkForTclOptions $test_channel
  }

  if {![info exists no(checkForBigLists)]} then {
    checkForBigLists $test_channel
  }





  if {![info exists no(checkForStackIntensive)]} then {
    checkForStackIntensive $test_channel
  }

  if {![info exists no(windowsCommandProcessor)]} then {
    checkForWindowsCommandProcessor $test_channel cmd.exe
................................................................................
    checkForCommand $test_channel xml
  }

  #
  # NOTE: Has namespace detection support been disabled?
  #
  if {![info exists no(namespaces)]} then {
    checkForNamespaces $test_channel
  }

  #
  # NOTE: Check for various features that were added through
  #       the TIP process.
  #
  if {![info exists no(tip127)]} then {
................................................................................
    checkForTip405 $test_channel
  }

  if {![info exists no(tip426)]} then {
    checkForTip426 $test_channel
  }





  #
  # NOTE: Has performance testing been disabled?
  #
  if {![info exists no(core)] && \
      ![info exists no(checkForPerformance)]} then {
    checkForPerformance $test_channel
  }
................................................................................
  if {![info exists no(core)] && \
      ![info exists no(timing)]} then {
    checkForTiming $test_channel 50; # 1/20th second.
  }

  if {![info exists no(core)] && \
      ![info exists no(preciseTiming)]} then {







    checkForTiming $test_channel 25 preciseTiming; # 1/40th second.
  }


  #
  # NOTE: Has interactive testing been disabled?
  #
  if {![info exists no(interactive)]} then {
    checkForInteractive $test_channel
  }







>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>







 







>
>
>
>
>
>
>
>
>







 







|
<


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
>







 







|
>







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>
>
>
>
>







 







>
>
>







 







>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







<
<
<
<
<
<
<
<
<
<
<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>







 







|







 







>
>
>
>







 







|







 







>
>
>
>







 







>
>
>
>
>
>
>
|
|
>







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
...
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
...
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
...
438
439
440
441
442
443
444
445

446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
...
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
...
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
...
628
629
630
631
632
633
634





















635
















636
637
638
639
640
641
642
...
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
...
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
...
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
...
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
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
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
....
1119
1120
1121
1122
1123
1124
1125











1126
1127
1128
1129
1130
1131
1132
....
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
....
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
....
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
....
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
....
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
....
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
....
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
    }

    unset pkg_dir
  }

  #############################################################################

  #
  # NOTE: Set the location of the Eagle main strong name keys directory,
  #       if necessary.
  #
  if {![info exists key_path]} then {
    #
    # NOTE: Normally, there should be a "Keys" sub-directory just within
    #       the base directory.
    #
    set key_path [file join $base_path Keys]
  }

  #############################################################################

  #
  # NOTE: Set the executable file name for the process, if
  #       necessary.
  #
  if {![info exists bin_file]} then {
    set bin_file [info nameofexecutable]
  }
................................................................................
  set test_flags(-skip) [list]; # default to skipping no tests.
  set test_flags(-constraints) [list]; # default to no manual constraints.
  set test_flags(-logFile) ""; # default to using standard log file naming.
  set test_flags(-threshold) ""; # default to requiring all tests to pass.
  set test_flags(-randomOrder) ""; # default to deterministic order.
  set test_flags(-breakOnLeak) ""; # default to continue on leak.
  set test_flags(-stopOnFailure) ""; # default to continue on failure.
  set test_flags(-stopOnLeak) ""; # default to continue on leak.
  set test_flags(-exitOnComplete) ""; # default to not exit after complete.
  set test_flags(-preTest) ""; # default to not evaluating anything.
  set test_flags(-postTest) ""; # default to not evaluating anything.
  set test_flags(-tclsh) ""; # Tcl shell, default to empty.

  #
  # NOTE: Check for and process any command line arguments.
................................................................................
        [string is boolean -strict $test_flags(-stopOnFailure)]} then {
      #
      # NOTE: Set the test stop-on-failure flag to the one provided by the
      #       command line.
      #
      set test_stop_on_failure $test_flags(-stopOnFailure)
    }

    if {[info exists test_flags(-stopOnLeak)] && \
        [string is boolean -strict $test_flags(-stopOnLeak)]} then {
      #
      # NOTE: Set the test stop-on-leak flag to the one provided by the
      #       command line.
      #
      set test_stop_on_leak $test_flags(-stopOnLeak)
    }

    if {[info exists test_flags(-exitOnComplete)] && \
        [string is boolean -strict $test_flags(-exitOnComplete)]} then {
      #
      # NOTE: Set the test exit-on-complete flag to the one provided by the
      #       command line.
      #
................................................................................
  # NOTE: Has automatic log file naming been disabled?
  #
  if {![info exists no(logFileName)]} then {
    #
    # NOTE: Set the log to use for test output, if necessary.
    #
    if {![info exists test_log]} then {
      set test_log [getDefaultTestLog]

    }
  }

  #############################################################################

  #
  # NOTE: *SPECIAL* This test constraint must be checked first as it can
  #       determine if subsequent ones will emit warnings.  This is only
  #       applicable to Eagle.
  #
  if {[isEagle]} then {
    #
    # NOTE: Has quiet testing support been disabled?
    #
    if {![info exists no(preQuiet)]} then {
      #
      # NOTE: There are checks for the "quiet" test constraint prior to
      #       the real test constraints being initialized.  Prepare for
      #       those checks now.  This will have to be repeated later,
      #       after the real test constraints are initialized.
      #
      checkForQuiet $test_channel true
    }
  }

  #############################################################################

  #
  # NOTE: Has native Tcl shell detection and use been disabled?
  #
  if {![info exists no(tclsh)]} then {
    #
    # NOTE: Set the Tcl shell executable to use for those specialized
................................................................................
        } else {
          if {[canExecTclShell] && \
              ![info exists no(getTclShellFileName)]} then {
            #
            # NOTE: Attempt to automatically select the native Tcl shell
            #       to use.
            #
            if {![info exists no(warningForTclShell)] && \
                ![haveConstraint quiet]} then {
              tputs $test_channel \
                  "==== WARNING: attempting automatic Tcl shell selection...\n"
            }

            set test_tclsh [getTclShellFileName true]
          } else {
            #
................................................................................
  #
  # NOTE: When running in Eagle, check for any non-core plugins loaded into
  #       the interpreter and issue warnings if any are found.  The warning
  #       may be used to explain subsequent test failures due to the extra
  #       plugins being loaded (i.e. there are some tests are sensitive to
  #       having "unexpected" plugins loaded).
  #
  if {[isEagle] && ![info exists no(warningForPlugin)] && \
      ![haveConstraint quiet]} then {
    foreach loaded [info loaded] {
      #
      # HACK: This code assumes that all plugins in the "Eagle._Plugins"
      #       namespace belong to the Eagle core library itself.
      #
      if {![string match Eagle._Plugins.* [lindex $loaded 1]]} then {
        tputs $test_channel [appendArgs \
................................................................................
      [expr {[info exists test_configuration] ? \
          $test_configuration : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- test suffix: " \
      [expr {[info exists test_suffix] ? \
          $test_suffix : "<none>"}] \n]






















  if {[isEagle]} then {
















    tputs $test_channel [appendArgs "---- original command line: " \
        [info cmdline] \n]

    tputs $test_channel [appendArgs "---- threadId: " \
        [info tid] \n]

    tputs $test_channel [appendArgs "---- processors: " \
................................................................................
          [string is boolean -strict $test_break_on_leak] ? \
              $test_break_on_leak : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- stop on failure: " \
      [expr {[info exists test_stop_on_failure] && \
          [string is boolean -strict $test_stop_on_failure] ? \
              $test_stop_on_failure : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- stop on leak: " \
      [expr {[info exists test_stop_on_leak] && \
          [string is boolean -strict $test_stop_on_leak] ? \
              $test_stop_on_leak : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- exit on complete: " \
      [expr {[info exists test_exit_on_complete] && \
          [string is boolean -strict $test_exit_on_complete] ? \
              $test_exit_on_complete : "<none>"}] \n]

  #
................................................................................

  tputs $test_channel [appendArgs "---- path: " \
      [expr {[info exists path] && [string length $path] > 0 ? \
          [appendArgs \" $path \"] : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- base path: \"" \
      $base_path \"\n]

  tputs $test_channel [appendArgs "---- key path: \"" \
      $key_path \"\n]

  tputs $test_channel [appendArgs "---- root path: \"" \
      $root_path \"\n]

  tputs $test_channel [appendArgs "---- binary path: \"" \
      $bin_path \"\n]

................................................................................
  tputs $test_channel [appendArgs "---- disabled options: " \
      [formatList [lsort [array names no]] <none>] \n]

  #
  # NOTE: Initialize the Eagle test constraints.
  #
  if {[isEagle]} then {
    #
    # NOTE: *WARNING* This has the effect of removing test constraints
    #       added prior to this point.
    #
    initializeTests; configureTcltest [list] [list] [list] [list] false

    #
    # NOTE: If the "no(mono)" variable is set (to anything) then any
    #       special test suite hacks for Mono will be disabled. This
    #       does not control or change any hacks for Mono that may
    #       be present in the library itself.
................................................................................

    ###########################################################################
    ######################### BEGIN Eagle Constraints #########################
    ###########################################################################

    tputs $test_channel \
        "---- start of Eagle specific test constraints...\n"

    #
    # NOTE: *WARNING* Has quiet testing support been disabled?
    #       Please do not move this "quietness" test constraint
    #       check as subsequent test constraints may rely on it
    #       when determining if a warning should be emitted.
    #
    if {![info exists no(quiet)]} then {
      #
      # NOTE: For tests "basic-1.36", "benchmark-1.*", "debug-1.3",
      #       "debug-1.4", "glob-99.*", "object-10.*", "perf-2.2",
      #       and various other places within the test suite code
      #       itself.
      #
      checkForQuiet $test_channel false
    }

    #
    # NOTE: Has strong name key detection been disabled?
    #
    if {![info exists no(strongNameKey)]} then {
      catch {info engine PublicKeyToken} publicKeyToken

      if {[string length $publicKeyToken] == 0} then {
        #
        # NOTE: The Eagle core library is not signed with a strong name key.
        #       This is not an error, per se; however, it may cause selected
        #       tests to fail and it should be reported to the user and noted
        #       in the test suite log file.
        #
        addConstraint strongName.none

        if {![info exists no(warningForStrongNameKey)] && \
            ![haveConstraint quiet]} then {
          tputs $test_channel \
              "==== WARNING: no Eagle strong name signature detected...\n"
        }
      } else {
        #
        # NOTE: Add a test constraint for this specific strong name key.
        #
        addConstraint [appendArgs strongName. $publicKeyToken]

        #
        # BUGBUG: Tcl 8.4 does not seem to like this expression because it
        #         contains the "ni" operator added in Tcl 8.5 (and Tcl 8.4
        #         tries to compile it even though it will only be evaluated
        #         in Eagle).
        #
        set expr {$publicKeyToken ni \
            "29c6297630be05eb 1e22ec67879739a2 358030063a832bc3"}

        if {[expr $expr]} then {
          #
          # NOTE: The Eagle core library is strong name signed with a key that
          #       is not official.  This is also not an error, per se; however,
          #       it may cause some tests to fail and it should be reported to
          #       the user and noted in the test suite log file.
          #
          addConstraint strongName.unofficial

          if {![info exists no(warningForStrongNameKey)] && \
              ![haveConstraint quiet]} then {
            tputs $test_channel [appendArgs \
                "==== WARNING: unofficial Eagle strong name signature " \
                "detected: " $publicKeyToken \n]
          }
        } else {
          #
          # NOTE: Several tests require one of the official strong name keys to
          #       be used in order for them to pass.
          #
          addConstraint strongName.official

          tputs $test_channel [appendArgs \
              "---- official Eagle strong name signature detected: " \
              $publicKeyToken \n]
        }

        unset expr
      }

      unset publicKeyToken
    }

    #
    # NOTE: Has administrator detection support been disabled?  We do
    #       this check [nearly] first as it may [eventually] be used
    #       to help determine if other constraints should be skipped.
    #
    if {![info exists no(administrator)]} then {
................................................................................
    #
    # NOTE: Has symbol testing support been disabled?
    #
    if {![info exists no(assemblySymbols)]} then {
      checkForSymbols $test_channel [lindex [info assembly] end]
    }












    #
    # NOTE: Has object handle reference count tracking support been disabled
    #       (at compile-time)?
    #
    if {![info exists no(refCount)]} then {
      #
      # NOTE: For tests "excel-*", "object-2.*", "object-7.1", "object-8.*",
................................................................................
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestSetVariableLinks*

        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestUnsetVariableLinks*
      }

      #
      # NOTE: Has system array variable testing support been disabled?
      #
      if {![info exists no(testSystemArrayVariables)]} then {
        #
        # NOTE: For tests "basic-1.62", "basic-1.63", "basic-1.64",
        #       and "basic-1.65".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestIntPtrChangeTypeCallback*

        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestSetVariableSystemArray*

        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestUnsetVariableSystemArray*
      }

      #
      # NOTE: Has field testing support been disabled?
      #
      if {![info exists no(testFields)]} then {
        #
        # NOTE: For tests "basic-1.39", "basic-1.40", "basic-1.41",
        #       "basic-1.42", and "basic-1.43".
................................................................................

        #
        # NOTE: For test "object-2.1".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestComplexMethod*

        #
        # NOTE: For test "object-2.12".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestMoreComplexMethod*

        #
        # NOTE: For test "object-2.3".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestToHexadecimalString*

        checkForObjectMember $test_channel Eagle._Tests.Default \
................................................................................
    checkForTestSuiteFiles $test_channel
  }

  #
  # NOTE: Has all use of [exec] for tests been disabled?
  #
  if {![info exists no(checkForTestExec)]} then {
    checkForTestExec $test_channel [haveConstraint quiet]
  }

  #
  # NOTE: Has checking for the test machine been disabled?
  #
  if {![info exists no(testMachine)]} then {
    checkForTestMachine $test_channel
................................................................................
  if {![info exists no(tclOptions)]} then {
    checkForTclOptions $test_channel
  }

  if {![info exists no(checkForBigLists)]} then {
    checkForBigLists $test_channel
  }

  if {![info exists no(checkForMemoryIntensive)]} then {
    checkForMemoryIntensive $test_channel
  }

  if {![info exists no(checkForStackIntensive)]} then {
    checkForStackIntensive $test_channel
  }

  if {![info exists no(windowsCommandProcessor)]} then {
    checkForWindowsCommandProcessor $test_channel cmd.exe
................................................................................
    checkForCommand $test_channel xml
  }

  #
  # NOTE: Has namespace detection support been disabled?
  #
  if {![info exists no(namespaces)]} then {
    checkForNamespaces $test_channel [haveConstraint quiet]
  }

  #
  # NOTE: Check for various features that were added through
  #       the TIP process.
  #
  if {![info exists no(tip127)]} then {
................................................................................
    checkForTip405 $test_channel
  }

  if {![info exists no(tip426)]} then {
    checkForTip426 $test_channel
  }

  if {![info exists no(tip429)]} then {
    checkForTip429 $test_channel
  }

  #
  # NOTE: Has performance testing been disabled?
  #
  if {![info exists no(core)] && \
      ![info exists no(checkForPerformance)]} then {
    checkForPerformance $test_channel
  }
................................................................................
  if {![info exists no(core)] && \
      ![info exists no(timing)]} then {
    checkForTiming $test_channel 50; # 1/20th second.
  }

  if {![info exists no(core)] && \
      ![info exists no(preciseTiming)]} then {
    #
    # NOTE: Normally, the "preciseTiming" constraint implicitly requires that
    #       the "timing" constraint be present as well; however, that can be
    #       overridden.
    #
    if {[info exists no(requireTiming)] || \
        [haveConstraint timing]} then {
      checkForTiming $test_channel 25 preciseTiming; # 1/40th second.
    }
  }

  #
  # NOTE: Has interactive testing been disabled?
  #
  if {![info exists no(interactive)]} then {
    checkForInteractive $test_channel
  }