System.Data.SQLite
Check-in [12a71d6811]
Not logged in

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

Overview
Comment:Update Eagle script library in externals to the latest trunk code.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | nextRelease
Files: files | file ages | folders
SHA1: 12a71d6811f6f3da46f2458f8c9c8e78cdc42f0e
User & Date: mistachkin 2015-03-03 03:15:00
Context
2015-03-04
19:42
Improve coding style in the CountParents method. check-in: 528007e621 user: mistachkin tags: nextRelease
2015-03-03
03:15
Update Eagle script library in externals to the latest trunk code. check-in: 12a71d6811 user: mistachkin tags: nextRelease
02:54
Pickup release archive verification tool changes from upstream. check-in: 8692ce7849 user: mistachkin tags: nextRelease
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

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

835
836
837
838
839
840
841
842

843

844

845
846
847
848
849
850
851
....
1237
1238
1239
1240
1241
1242
1243
1244






1245
1246
1247
1248























1249
1250
1251
1252
1253
1254
1255
....
1309
1310
1311
1312
1313
1314
1315
1316
1317





1318
1319
1320
1321
1322
1323
1324
1325
1326
....
1423
1424
1425
1426
1427
1428
1429






1430
1431
1432
1433
1434
1435

1436
1437

1438
1439
1440
1441
1442
1443
1444
....
1452
1453
1454
1455
1456
1457
1458
1459

1460
1461

1462
1463
1464
1465
1466
1467
1468
....
1532
1533
1534
1535
1536
1537
1538
1539

1540
1541
1542
1543
1544
1545
1546
....
1771
1772
1773
1774
1775
1776
1777
1778

1779
1780
1781
1782
1783
1784
1785

1786
1787
1788
1789
1790
1791
1792
        #
        # NOTE: Grab the Nth process array element value using the
        #       accessor method.
        #
        set process [$array -alias GetValue $index]

        #
        # NOTE: Add the Id of the process to the result list.

        #

        lappend result [$process Id]


        #
        # NOTE: Get rid of the process object, we no longer need it.
        #       Technically, it is not a requirement to explicitly
        #       unset variables that contain object references;
        #       however, it is useful in helping to document the
        #       code.
................................................................................
    proc runUpdateAndExit { {automatic false} } {
      set directory [file dirname [info nameofexecutable]]

      set command [list exec -shell -- \
          [file join $directory Hippogriff.exe] -delay 2000]

      if {$automatic} then {
        eval lappend command -silent true -confirm false






      }

      eval $command &; exit -force
    }























 
    proc getUpdateData { uri } {
      #
      # NOTE: Start trusting ONLY our own self-signed SSL certificate.
      #
      set trusted true

................................................................................
    #       "#check" command.  To disable this functionality, simply
    #       redefine this procedure to do nothing.
    #
    proc checkForUpdate {
            {wantScripts false} {quiet false} {prompt false}
            {automatic false} } {
      #
      # NOTE: This should work properly in Eagle only.
      #





      set updateUri [appendArgs \
          [info engine UpdateBaseUri] [info engine UpdatePathAndQuery]]

      #
      # NOTE: Fetch the master update data from the distribution site
      #       and normalize to Unix-style line-endings.
      #
      set updateData [string map [list \r\n \n] [getUpdateData $updateUri]]

................................................................................
              #
              set timeStamp [lindex $fields 5]

              if {[string length $timeStamp] == 0} then {
                set timeStamp 0; #never?
              }







              #
              # NOTE: Does it look like the number of seconds since the epoch
              #       or some kind of date/time string?
              #
              if {[string is integer -strict $timeStamp]} then {
                set dateTime [clock format $timeStamp]

              } else {
                set dateTime [clock format [clock scan $timeStamp]]

              }

              #
              # NOTE: Grab the patch level for the running engine.
              #
              set enginePatchLevel [info engine PatchLevel]

................................................................................
              }

              #
              # NOTE: Does it look like the number of seconds since the epoch
              #       or some kind of date/time string?
              #
              if {[string is integer -strict $engineTimeStamp]} then {
                set engineDateTime [clock format $engineTimeStamp]

              } else {
                set engineDateTime [clock format [clock scan $engineTimeStamp]]

              }

              #
              # NOTE: For build lines, compare the patch level from the line
              #       to the one we are currently using using a simple patch
              #       level comparison.
              #
................................................................................
                  #
                  # NOTE: Are we supposed to prompt the interactive user,
                  #       if any, to upgrade now?
                  #
                  set text [appendArgs \
                      "latest build " $patchLevel ", dated " $dateTime \
                      ", is newer than the running build " $enginePatchLevel \
                      ", dated " $engineDateTime]


                  if {$prompt && [isInteractive]} then {
                    set caption [appendArgs \
                        [info engine Name] " " [lindex [info level 0] 0]]

                    if {[object invoke -flags +NonPublic \
                        Eagle._Components.Private.WindowOps YesOrNo \
................................................................................
                #
                # NOTE: The patch level from the line is less, we are more
                #       up-to-date than the latest version?
                #
                return [list [appendArgs \
                    "running build " $enginePatchLevel ", dated " \
                    $engineDateTime ", is newer than the latest build " \
                    $patchLevel ", dated " $dateTime]]

              } elseif {$checkBuild} then {
                #
                # NOTE: The patch levels are equal, we are up-to-date.
                #
                return [list [appendArgs \
                    "running build " $enginePatchLevel ", dated " \
                    $engineDateTime ", is the latest build"]]

              }
            }
          }
        }
      }

      #







|
>

>
|
>







 







|
>
>
>
>
>
>




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







 







|

>
>
>
>
>

|







 







>
>
>
>
>
>





|
>

|
>







 







|
>

|
>







 







|
>







 







|
>






|
>







835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
....
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
....
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
....
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
....
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
....
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
....
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
        #
        # NOTE: Grab the Nth process array element value using the
        #       accessor method.
        #
        set process [$array -alias GetValue $index]

        #
        # NOTE: Add the Id of the process to the result list.  This
        #       may fail on some versions of Mono.
        #
        if {[catch {$process Id} id] == 0} then {
          lappend result $id
        }

        #
        # NOTE: Get rid of the process object, we no longer need it.
        #       Technically, it is not a requirement to explicitly
        #       unset variables that contain object references;
        #       however, it is useful in helping to document the
        #       code.
................................................................................
    proc runUpdateAndExit { {automatic false} } {
      set directory [file dirname [info nameofexecutable]]

      set command [list exec -shell -- \
          [file join $directory Hippogriff.exe] -delay 2000]

      if {$automatic} then {
        lappend command -silent true -confirm false
      }

      set baseUri [getUpdateBaseUri]

      if {[string length $baseUri] > 0} then {
        lappend command -baseUri $baseUri
      }

      eval $command &; exit -force
    }
 
    proc getUpdateBaseUri {} {
      #
      # NOTE: Check the current base URI for updates against the one baked
      #       into the assembly.  If they are different, then the base URI
      #       must have been overridden.  In that case, we must return the
      #       current base URI; otherwise, we must return an empty string.
      #
      set baseUri(0) [info engine UpdateBaseUri false]; # NOTE: Current.
      set baseUri(1) [info engine UpdateBaseUri true];  # NOTE: Default.

      if {[string length $baseUri(0)] > 0 && \
          [string length $baseUri(1)] > 0} then {
        #
        # NOTE: Ok, they are both valid.  Are they different?
        #
        if {$baseUri(0) ne $baseUri(1)} then {
          return $baseUri(0)
        }
      }

      return ""
    }
 
    proc getUpdateData { uri } {
      #
      # NOTE: Start trusting ONLY our own self-signed SSL certificate.
      #
      set trusted true

................................................................................
    #       "#check" command.  To disable this functionality, simply
    #       redefine this procedure to do nothing.
    #
    proc checkForUpdate {
            {wantScripts false} {quiet false} {prompt false}
            {automatic false} } {
      #
      # NOTE: Grab the base URI for updates.
      #
      set updateBaseUri [info engine UpdateBaseUri]

      #
      # NOTE: Append the path and query string used for updates to it.
      #
      set updateUri [appendArgs \
          $updateBaseUri [info engine UpdatePathAndQuery]]

      #
      # NOTE: Fetch the master update data from the distribution site
      #       and normalize to Unix-style line-endings.
      #
      set updateData [string map [list \r\n \n] [getUpdateData $updateUri]]

................................................................................
              #
              set timeStamp [lindex $fields 5]

              if {[string length $timeStamp] == 0} then {
                set timeStamp 0; #never?
              }

              #
              # NOTE: What should the DateTime format be for display?  This
              #       should be some variation on ISO-8601.
              #
              set dateTimeFormat yyyy-MM-ddTHH:mm:ss

              #
              # NOTE: Does it look like the number of seconds since the epoch
              #       or some kind of date/time string?
              #
              if {[string is integer -strict $timeStamp]} then {
                set dateTime [clock format \
                    $timeStamp -format $dateTimeFormat]
              } else {
                set dateTime [clock format \
                    [clock scan $timeStamp] -format $dateTimeFormat]
              }

              #
              # NOTE: Grab the patch level for the running engine.
              #
              set enginePatchLevel [info engine PatchLevel]

................................................................................
              }

              #
              # NOTE: Does it look like the number of seconds since the epoch
              #       or some kind of date/time string?
              #
              if {[string is integer -strict $engineTimeStamp]} then {
                set engineDateTime [clock format \
                    $engineTimeStamp -format $dateTimeFormat]
              } else {
                set engineDateTime [clock format \
                    [clock scan $engineTimeStamp] -format $dateTimeFormat]
              }

              #
              # NOTE: For build lines, compare the patch level from the line
              #       to the one we are currently using using a simple patch
              #       level comparison.
              #
................................................................................
                  #
                  # NOTE: Are we supposed to prompt the interactive user,
                  #       if any, to upgrade now?
                  #
                  set text [appendArgs \
                      "latest build " $patchLevel ", dated " $dateTime \
                      ", is newer than the running build " $enginePatchLevel \
                      ", dated " $engineDateTime ", based on data from " \
                      $updateBaseUri]

                  if {$prompt && [isInteractive]} then {
                    set caption [appendArgs \
                        [info engine Name] " " [lindex [info level 0] 0]]

                    if {[object invoke -flags +NonPublic \
                        Eagle._Components.Private.WindowOps YesOrNo \
................................................................................
                #
                # NOTE: The patch level from the line is less, we are more
                #       up-to-date than the latest version?
                #
                return [list [appendArgs \
                    "running build " $enginePatchLevel ", dated " \
                    $engineDateTime ", is newer than the latest build " \
                    $patchLevel ", dated " $dateTime ", based on data " \
                    "from " $updateBaseUri]]
              } elseif {$checkBuild} then {
                #
                # NOTE: The patch levels are equal, we are up-to-date.
                #
                return [list [appendArgs \
                    "running build " $enginePatchLevel ", dated " \
                    $engineDateTime ", is the latest build, based on " \
                    "data from " $updateBaseUri]]
              }
            }
          }
        }
      }

      #

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
....
1970
1971
1972
1973
1974
1975
1976



















1977
1978
1979
1980
1981
1982
1983















1984
1985
1986
1987
1988
1989
1990
....
2563
2564
2565
2566
2567
2568
2569











































2570
2571
2572
2573
2574
2575
2576

    #
    # 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.
................................................................................
          if {[isEagle]} then {
            set before $::eagle_tests(Failed)
          } else {
            set before $::tcltest::numTests(Failed)
          }

          #



















          # NOTE: Evaluate the file in the context of the caller,
          #       catching any errors.  If an error is raised and the
          #       stop-on-failure flag is set, assume it was a test
          #       failure and that we need to stop any and all further
          #       processing of test files.
          #
          if {[catch {uplevel 1 [list source $fileName]} error]} then {















            #
            # NOTE: Most likely, this error was caused by malformed or
            #       incorrect code in-between the tests themselves.  We
            #       need to report this.
            #
            tputs $channel [appendArgs "==== \"" $fileName "\" ERROR \"" \
                $error \"\n]
................................................................................
        }
      } else {
        return true; # already dead?
      }

      return false; # still alive (or error).
    }











































 
    proc purgeAndCleanup { channel name } {
      catch {uplevel 1 [list debug purge]} result

      tputs $channel [appendArgs \
          "---- purge \"" $name "\" results: " $result \n]








|
|







 







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







 







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







483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
....
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
....
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653

    #
    # 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 \
        -postWait -preWait -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.
................................................................................
          if {[isEagle]} then {
            set before $::eagle_tests(Failed)
          } else {
            set before $::tcltest::numTests(Failed)
          }

          #
          # NOTE: Evaluate the test file, optionally waiting for a certain
          #       number of milliseconds before and/or after doing so.
          #
          if {[catch {
            #
            # NOTE: Are we being prevented from waiting before the file?
            #
            if {![info exists ::no(preWait)]} then {
              if {[info exists ::test_wait(pre)] && \
                  [string is integer -strict $::test_wait(pre)]} then {
                tputs $channel [appendArgs \
                    "---- waiting for " $::test_wait(pre) \
                    " milliseconds before test file...\n"]

                after $::test_wait(pre); # NOTE: Sleep.
              }
            }

            #
            # NOTE: Evaluate the file in the context of the caller,
            #       catching any errors.  If an error is raised and the
            #       stop-on-failure flag is set, assume it was a test
            #       failure and that we need to stop any and all further
            #       processing of test files.
            #
            uplevel 1 [list source $fileName]

            #
            # NOTE: Are we being prevented from waiting after the file?
            #
            if {![info exists ::no(postWait)]} then {
              if {[info exists ::test_wait(post)] && \
                  [string is integer -strict $::test_wait(post)]} then {
                tputs $channel [appendArgs \
                    "---- waiting for " $::test_wait(post) \
                    " milliseconds after test file...\n"]

                after $::test_wait(post); # NOTE: Sleep.
              }
            }
          } error]} then {
            #
            # NOTE: Most likely, this error was caused by malformed or
            #       incorrect code in-between the tests themselves.  We
            #       need to report this.
            #
            tputs $channel [appendArgs "==== \"" $fileName "\" ERROR \"" \
                $error \"\n]
................................................................................
        }
      } else {
        return true; # already dead?
      }

      return false; # still alive (or error).
    }
 
    proc reportTestConstraintCounts { channel skippedNames } {
      #
      # NOTE: Process the list of skipped tests, which is really a dictionary
      #       of test names to the list of constraints that caused them to be
      #       skipped.  We need to "roll them up", on a per-constraint basis,
      #       and produce counts for each constraint.  At the same time, we
      #       need to keep track of the maximum count seen, to help align the
      #       final output.
      #
      set maximum 0

      foreach {testName constraintNames} $skippedNames {
        foreach constraintName $constraintNames {
          if {[info exists skippedCounts($constraintName)]} then {
            incr skippedCounts($constraintName)
          } else {
            set skippedCounts($constraintName) 1
          }

          if {$skippedCounts($constraintName) > $maximum} then {
            set maximum $skippedCounts($constraintName)
          }
        }
      }

      #
      # NOTE: Produce the final output, which includes a single line header
      #       followed by one line per test constraint seen.
      #
      if {$maximum > 0 && [array size skippedCounts] > 0} then {
        set places [expr {int(log10($maximum)) + 1}]

        tputs $channel "Number of tests skipped for each constraint:\n"

        foreach {name value} [array get skippedCounts] {
          tputs $channel [appendArgs \
              \t [format [appendArgs % $places s] $value] \t $name \n]
        }

        tputs $channel \n
      }
    }
 
    proc purgeAndCleanup { channel name } {
      catch {uplevel 1 [list debug purge]} result

      tputs $channel [appendArgs \
          "---- purge \"" $name "\" results: " $result \n]

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

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
...
102
103
104
105
106
107
108





















109
110
111
112
113
114
115
...
146
147
148
149
150
151
152







































































































153
154
155
156
157
158
159
....
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
....
1447
1448
1449
1450
1451
1452
1453















1454
1455
1456
1457
1458
1459
1460
....
1569
1570
1571
1572
1573
1574
1575
1576
1577

1578
1579
1580
1581
1582
1583
1584
....
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
....
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
....
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
....
1915
1916
1917
1918
1919
1920
1921

1922
1923

1924











1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
....
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
....
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
....
2965
2966
2967
2968
2969
2970
2971




























































2972
2973
2974
2975
2976
2977
2978
....
2987
2988
2989
2990
2991
2992
2993
2994


2995

2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007




3008
3009





3010
3011
3012
3013
3014
3015
3016
....
3228
3229
3230
3231
3232
3233
3234
3235

3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246

3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
        NET_20_SP1 NET_20_SP2 NET_30 NET_35 NET_40 NET_45 NET_451 NET_452 \
        NON_WORKING_CODE NOTIFY NOTIFY_ACTIVE NOTIFY_ARGUMENTS \
        NOTIFY_EXCEPTION NOTIFY_EXECUTE NOTIFY_EXPRESSION NOTIFY_GLOBAL \
        NOTIFY_OBJECT OBSOLETE OFFICIAL PARSE_CACHE PATCHLEVEL POLICY_TRACE \
        PREVIOUS_RESULT RANDOMIZE_ID REMOTING SAMPLE SERIALIZATION \
        SHARED_ID_POOL SHELL SOURCE_ID SOURCE_TIMESTAMP STATIC TCL TCL_KITS \
        TCL_THREADED TCL_THREADS TCL_UNICODE TCL_WRAPPER TEST THREADING \
        THROW_ON_DISPOSED TRACE TYPE_CACHE UNIX VERBOSE WEB WINDOWS WINFORMS \
        WIX_30 WIX_35 WIX_36 WIX_37 WIX_38 X64 X86 XML]
  }
 
  proc getKnownMonoVersions {} {
    #
    # NOTE: This job of this procedure is to return the list of "known"
    #       versions of Mono supported by the test suite infrastructure.
    #
    return [list \
        [list 2 0] [list 2 2] [list 2 4] [list 2 6] [list 2 8] [list 2 10] \
        [list 2 11] [list 2 12] [list 3 0] [list 3 1] [list 3 2] [list 3 3] \
        [list 3 4] [list 3 5] [list 3 6]]
  }
 
  #
  # NOTE: This procedure was adapted from the one listed on the Tcl Wiki page
  #       at "http://wiki.tcl.tk/43".  It is only intended to be used on very
  #       small lists because of its heavy use of recursion and complexity on
  #       the order of O(N!).
................................................................................
    #       return true.
    #
    return [expr {
      [catch {interp readylimit {}} readylimit] != 0 || $readylimit == 0
    }]
  }
 





















  #
  # NOTE: This procedure should return non-zero if the native Tcl shell may
  #       be executed by the test suite infrastructure outside the context
  #       of any specific tests.  The specific tests themselves must make
  #       use of their own constraints to prevent execution of the native
  #       Tcl shell.
  #
................................................................................

    if {[info exists ::no(canExecFossil)]} then {
      return false
    }

    return true
  }







































































































 
  proc checkForTestSuiteFiles { channel } {
    tputs $channel "---- checking for test suite files... "

    #
    # NOTE: Start out with no test suite files to check.
    #
................................................................................
    if {![info exists ::no(bigLists)]} then {
      if {[isEagle]} then {
        #
        # MONO: Using the native utility library when running on Mono to
        #       join big lists seems to cause StackOverflowException to
        #       be thrown.
        #
        if {[info exists ::no(mono)] || ![isMono] || \
            ![haveConstraint nativeUtility]} then {
          #
          # NOTE: Yes, it appears that it is available.
          #
          addConstraint bigLists

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

        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?
    #
................................................................................
        "---- checking for network connectivity to host \"" $host "\"... "]

    if {[isEagle]} then {
      #
      # NOTE: Running this check on the Mono 3.3.0 (or 3.4.0?) release build
      #       will lock up the process; therefore, skip it in that case.
      #
      if {[info exists ::no(mono)] || ![isMono] || \
          (![haveConstraint mono33] && ![haveConstraint mono34])} then {

        #
        # BUGBUG: Tcl 8.4 does not like this expression (and Tcl tries to
        #         compile it even though it will only actually ever be
        #         evaluated in Eagle).
        #
        set expr {[llength [info commands uri]] > 0 && \
            [catch {uri ping $host $timeout} response] == 0 && \
................................................................................
          addConstraint [appendArgs network_ $host]

          tputs $channel [appendArgs "yes (" $response ")\n"]
        } else {
          tputs $channel no\n
        }
      } else {
        tputs $channel "skipped, may hang on Mono 3.3.0 and 3.4.0\n"
      }
    } else {
      #
      # HACK: Running in Tcl, just assume we have network access.
      #
      addConstraint [appendArgs network_ $host]

................................................................................
        tputs $channel no\n
      }
    }
 
    proc checkForCertificate { channel } {
      tputs $channel "---- checking for certificate... "

      if {[catch {object invoke Interpreter.GetActive GetCertificate} \
              certificate] == 0 && \
          [string length $certificate] > 0} then {
        #
        # NOTE: Yes, it appears that the core library was signed with a
        #       code-signing certificate.
        #
        addConstraint certificate

        tputs $channel [appendArgs "yes (" \




            [object invoke $certificate Subject] ")\n"]








      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForCompileCSharp { channel } {
      tputs $channel "---- checking for test use of C# compiler... "
................................................................................
        tputs $channel no\n
      }
    }
 
    proc checkForAdministrator { channel } {
      tputs $channel "---- checking for administrator... "

      if {[isAdministrator]} then {
        addConstraint administrator; # running as full admin.

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    }
................................................................................
        tputs $channel [appendArgs "no (" $threadId ")\n"]
      }
    }
 
    proc checkForDefaultAppDomain { channel } {
      tputs $channel "---- checking for default application domain... "


      if {[catch {object invoke AppDomain CurrentDomain} appDomain] == 0 && \
          [string length $appDomain] > 0} then {

        if {[object invoke $appDomain IsDefaultAppDomain]} then {











          addConstraint defaultAppDomain

          tputs $channel [appendArgs "yes (" [object invoke $appDomain Id] \
              ")\n"]
        } else {
          tputs $channel [appendArgs "no (" [object invoke $appDomain Id] \
              ")\n"]
        }
      } else {
        tputs $channel [appendArgs "no (null)\n"]
      }
    }
 
    proc checkForRuntime { channel } {
      tputs $channel "---- checking for runtime... "

      #
      # NOTE: Are we running inside Mono (regardless of operating system)?
      #
      if {![info exists ::no(mono)] && [isMono]} then {
        #
        # NOTE: Yes, it appears that we are running inside Mono.
        #
        addConstraint mono; # running on Mono.

        tputs $channel [appendArgs [expr {[info exists \
            ::eagle_platform(runtime)] ? \
................................................................................

        #
        # NOTE: Now create a version string for use in the constraint name
        #       (remove the periods).
        #
        set version [string map [list . ""] $dotVersion]

        if {![info exists ::no(mono)] && [isMono]} then {
          #
          # NOTE: If the runtime version was found, add a test constraint
          #       for it now.
          #
          if {[string length $version] > 0} then {
              #
              # NOTE: We are running on Mono.  Keep track of the specific
................................................................................
      tputs $channel "---- checking for database... "

      #
      # HACK: Disable database connectivity testing on Mono because
      #       it fails to timeout (unless special test suite hacks
      #       for Mono have been disabled by the user).
      #
      if {[info exists ::no(mono)] || ![isMono]} then {
        #
        # NOTE: Can we access the local database?
        #
        if {[catch {sql open -type $type $string} connection] == 0} then {
          #
          # NOTE: Yes, it appears that we can connect to the local database.
          #
................................................................................
        } else {
          tputs $channel unknown\n
        }
      } else {
        tputs $channel no\n
      }
    }




























































 
    proc checkForNetFx45 { channel } {
      tputs $channel "---- checking for .NET Framework 4.5... "

      #
      # NOTE: Platform must be Windows for this constraint to even be
      #       checked (i.e. we require the registry).
................................................................................
        set key [appendArgs HKEY_LOCAL_MACHINE\\ \
            {Software\Microsoft\NET Framework Setup\NDP\v4\Full}]

        #
        # NOTE: Attempt to fetch the .NET Framework 4.0 "release" value from
        #       the servicing registry hive.  If this value does not exist
        #       -OR- is less than 378389, then the .NET Framework 4.5 is not
        #       installed.


        #

        set release [object invoke Microsoft.Win32.Registry GetValue $key \
            Release null]

        if {[string is integer -strict $release] && $release >= 378389} then {
          #
          # NOTE: Yes, it appears that it is available.
          #
          addConstraint dotNet45OrHigher

          #
          # NOTE: If the "release" value is greater than or equal to 378758,
          #       then the .NET Framework 4.5.1 is installed.




          #
          if {$release >= 378758} then {





            addConstraint dotNet451
            addConstraint dotNet451OrHigher

            set version 4.5.1
          } else {
            addConstraint dotNet45

................................................................................

    #
    # NOTE: We need several of our test constraint related commands in the
    #       global namespace.
    #
    exportAndImportPackageCommands [namespace current] [list \
        getKnownCompileOptions getKnownMonoVersions lpermute \
        alwaysFullInterpReady canExecTclShell canExecFossil \

        checkForTestSuiteFiles checkForPlatform checkForWindowsVersion \
        checkForScriptLibrary checkForVariable checkForTclOptions \
        checkForWindowsCommandProcessor checkForFossil checkForEagle \
        checkForSymbols checkForLogFile checkForGaruda checkForShell \
        checkForDebug checkForTk checkForVersion checkForCommand \
        checkForNamespaces checkForTestExec checkForTestMachine \
        checkForTestPlatform checkForTestConfiguration checkForTestSuffix \
        checkForFile checkForPathFile checkForNativeCode checkForTip127 \
        checkForTip194 checkForTip207 checkForTip241 checkForTip285 \
        checkForTip405 checkForTip426 checkForTip429 checkForTiming \
        checkForPerformance checkForBigLists checkForMemoryIntensive \

        checkForStackIntensive checkForInteractive checkForInteractiveCommand \
        checkForUserInteraction checkForNetwork checkForCompileOption \
        checkForKnownCompileOptions] false false

    ###########################################################################
    ############################## 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"}]
}
 







|
|










|







 







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







 







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







 







<
|







 







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







 







|
|
>







 







|







 







|
|
|






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







 







|







 







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


|
<

|
<












|







 







|







 







|







 







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







 







|
>
>

>
|
|








|
|
>
>
>
>

|
>
>
>
>
>







 







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













39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
...
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
130
131
132
133
134
135
136
...
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
....
1551
1552
1553
1554
1555
1556
1557

1558
1559
1560
1561
1562
1563
1564
1565
....
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
....
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
....
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
....
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967

1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
....
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
....
2065
2066
2067
2068
2069
2070
2071
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
....
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
....
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
....
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
....
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
....
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472

3473
3474
3475
3476
3477
3478
3479
3480
3481
3482

3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
        NET_20_SP1 NET_20_SP2 NET_30 NET_35 NET_40 NET_45 NET_451 NET_452 \
        NON_WORKING_CODE NOTIFY NOTIFY_ACTIVE NOTIFY_ARGUMENTS \
        NOTIFY_EXCEPTION NOTIFY_EXECUTE NOTIFY_EXPRESSION NOTIFY_GLOBAL \
        NOTIFY_OBJECT OBSOLETE OFFICIAL PARSE_CACHE PATCHLEVEL POLICY_TRACE \
        PREVIOUS_RESULT RANDOMIZE_ID REMOTING SAMPLE SERIALIZATION \
        SHARED_ID_POOL SHELL SOURCE_ID SOURCE_TIMESTAMP STATIC TCL TCL_KITS \
        TCL_THREADED TCL_THREADS TCL_UNICODE TCL_WRAPPER TEST THREADING \
        THROW_ON_DISPOSED TRACE TYPE_CACHE UNIX USE_NAMESPACES VERBOSE WEB \
        WINDOWS WINFORMS WIX_30 WIX_35 WIX_36 WIX_37 WIX_38 WIX_39 X64 X86 XML]
  }
 
  proc getKnownMonoVersions {} {
    #
    # NOTE: This job of this procedure is to return the list of "known"
    #       versions of Mono supported by the test suite infrastructure.
    #
    return [list \
        [list 2 0] [list 2 2] [list 2 4] [list 2 6] [list 2 8] [list 2 10] \
        [list 2 11] [list 2 12] [list 3 0] [list 3 1] [list 3 2] [list 3 3] \
        [list 3 4] [list 3 5] [list 3 6] [list 3 8] [list 3 10] [list 3 12]]
  }
 
  #
  # NOTE: This procedure was adapted from the one listed on the Tcl Wiki page
  #       at "http://wiki.tcl.tk/43".  It is only intended to be used on very
  #       small lists because of its heavy use of recursion and complexity on
  #       the order of O(N!).
................................................................................
    #       return true.
    #
    return [expr {
      [catch {interp readylimit {}} readylimit] != 0 || $readylimit == 0
    }]
  }
 
  #
  # NOTE: This procedure should return non-zero if the "whoami" command may
  #       be executed by the test suite infrastructure outside the context
  #       of any specific tests.
  #
  proc canExecWhoAmI {} {
    if {[info exists ::no(exec)]} then {
      return false
    }

    if {[info exists ::no(whoami)]} then {
      return false
    }

    if {[info exists ::no(canExecWhoAmI)]} then {
      return false
    }

    return true
  }
 
  #
  # NOTE: This procedure should return non-zero if the native Tcl shell may
  #       be executed by the test suite infrastructure outside the context
  #       of any specific tests.  The specific tests themselves must make
  #       use of their own constraints to prevent execution of the native
  #       Tcl shell.
  #
................................................................................

    if {[info exists ::no(canExecFossil)]} then {
      return false
    }

    return true
  }
 
  #
  # NOTE: This procedure should return non-zero if the test suite should be
  #       considered to be running on Mono.
  #
  proc isTestMono {} {
    return [expr {![info exists ::no(mono)] && [isMono]}]
  }
 
  proc isTestAdministrator { {force false} } {
    #
    # NOTE: This is a workaround for the [isAdministrator] procedure being
    #       inaccurate for Mono on Windows, primarily due to the inability
    #       of Mono to call a P/Invoke method by ordinal.  Also, this can
    #       be used for native Tcl on Windows.  This only works on Windows.
    #
    if {[isWindows]} then {
      #
      # NOTE: Normally, this is only used for native Tcl or Eagle on Mono;
      #       however, it can be used for Eagle on the .NET Framework if
      #       forced.
      #
      if {$force || ![isEagle] || [isTestMono]} then {
        if {[canExecWhoAmI] && \
            [catch {exec -- whoami /groups} groups] == 0} then {
          set groups [string map [list \r\n \n] $groups]

          foreach group [split $groups \n] {
            #
            # NOTE: Match this group line against the "well-known" SID for
            #       the "Administrators" group on Windows.
            #
            if {[regexp -- {\sS-1-5-32-544\s} $group]} then {
              #
              # NOTE: Match this group line against the attributes column
              #       sub-value that should be present when running with
              #       elevated administrator credentials.
              #
              if {[regexp -- {\sEnabled group(?:,|\s)} $group]} then {
                return true
              }
            }
          }
        }
      }
    }

    #
    # NOTE: We must be running in native Tcl, running on Unix, running in
    #       Eagle on the .NET Framework, or unable to execute the "whoami"
    #       command.  If running in Eagle, we can just fallback to using
    #       the [isAdministrator] procedure; otherwise, just return false.
    #
    return [expr {[isEagle] ? [isAdministrator] : false}]
  }
 
  proc canPing { {varName ""} } {
    #
    # NOTE: If requested by the caller, provide a reason whenever false is
    #       returned from this procedure.
    #
    if {[string length $varName] > 0} then {
      upvar 1 $varName reason
    }

    #
    # NOTE: Native Tcl (without extra packages) does not provide support for
    #       pinging a network host.
    #
    if {[isEagle]} then {
      if {[isTestMono]} then {
        #
        # NOTE: Using [uri ping] on the Mono 3.3.0 (or 3.4.0?) release will
        #       lock up the process; therefore, skip it in that case.
        #
        if {[haveConstraint mono33] || [haveConstraint mono34]} then {
          set reason "skipped, may hang on Mono 3.3.0 and 3.4.0"
          return false
        }

        #
        # NOTE: Other versions of Mono, e.g. 3.12, appear to require elevated
        #       privileges (i.e. full administrator) in order to successfully
        #       execute [uri ping].  This has been verified on Windows.
        #
        if {![isTestAdministrator]} then {
          set reason "skipped, need administrator privileges"
          return false
        }
      }

      #
      # NOTE: Eagle, when running on the Microsoft .NET Framework, supports
      #       pinging a network host as long as it was compiled with network
      #       support (which this procedure purposely does not check).  That
      #       is done using [checkForCompileOption], by the test prologue.
      #
      return true
    }

    set reason "skipped, need Eagle"
    return false
  }
 
  proc checkForTestSuiteFiles { channel } {
    tputs $channel "---- checking for test suite files... "

    #
    # NOTE: Start out with no test suite files to check.
    #
................................................................................
    if {![info exists ::no(bigLists)]} then {
      if {[isEagle]} then {
        #
        # MONO: Using the native utility library when running on Mono to
        #       join big lists seems to cause StackOverflowException to
        #       be thrown.
        #

        if {![isTestMono] || ![haveConstraint nativeUtility]} then {
          #
          # NOTE: Yes, it appears that it is available.
          #
          addConstraint bigLists

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

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

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

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

    #
    # NOTE: Are we allowed to do memory intensive testing?
    #
................................................................................
        "---- checking for network connectivity to host \"" $host "\"... "]

    if {[isEagle]} then {
      #
      # NOTE: Running this check on the Mono 3.3.0 (or 3.4.0?) release build
      #       will lock up the process; therefore, skip it in that case.
      #
      set reason unknown

      if {[canPing reason]} then {
        #
        # BUGBUG: Tcl 8.4 does not like this expression (and Tcl tries to
        #         compile it even though it will only actually ever be
        #         evaluated in Eagle).
        #
        set expr {[llength [info commands uri]] > 0 && \
            [catch {uri ping $host $timeout} response] == 0 && \
................................................................................
          addConstraint [appendArgs network_ $host]

          tputs $channel [appendArgs "yes (" $response ")\n"]
        } else {
          tputs $channel no\n
        }
      } else {
        tputs $channel [appendArgs $reason \n]
      }
    } else {
      #
      # HACK: Running in Tcl, just assume we have network access.
      #
      addConstraint [appendArgs network_ $host]

................................................................................
        tputs $channel no\n
      }
    }
 
    proc checkForCertificate { channel } {
      tputs $channel "---- checking for certificate... "

      if {[catch {
        object invoke Interpreter.GetActive GetCertificate
      } certificate] == 0 && [string length $certificate] > 0} then {
        #
        # NOTE: Yes, it appears that the core library was signed with a
        #       code-signing certificate.
        #
        addConstraint certificate


        #
        # NOTE: Attempt to query the subject from the certificate.
        #
        if {[catch {
          object invoke $certificate Subject
        } subject] != 0 || [string length $subject] == 0} then {
          #
          # TODO: No certificate subject, better handling here?
          #
          set subject unknown
        }

        tputs $channel [appendArgs "yes (" $subject ")\n"]
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForCompileCSharp { channel } {
      tputs $channel "---- checking for test use of C# compiler... "
................................................................................
        tputs $channel no\n
      }
    }
 
    proc checkForAdministrator { channel } {
      tputs $channel "---- checking for administrator... "

      if {[isTestAdministrator]} then {
        addConstraint administrator; # running as full admin.

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    }
................................................................................
        tputs $channel [appendArgs "no (" $threadId ")\n"]
      }
    }
 
    proc checkForDefaultAppDomain { channel } {
      tputs $channel "---- checking for default application domain... "

      if {[catch {
        object invoke AppDomain CurrentDomain
      } appDomain] == 0 && [string length $appDomain] > 0} then {
        if {[catch {
          object invoke $appDomain IsDefaultAppDomain
        } default] != 0 || [string length $default] == 0} then {
          set default false
        }

        if {[catch {
          object invoke $appDomain Id
        } id] != 0 || [string length $id] == 0} then {
          set id unknown
        }

        if {$default} then {
          addConstraint defaultAppDomain

          tputs $channel [appendArgs "yes (" $id ")\n"]

        } else {
          tputs $channel [appendArgs "no (" $id ")\n"]

        }
      } else {
        tputs $channel [appendArgs "no (null)\n"]
      }
    }
 
    proc checkForRuntime { channel } {
      tputs $channel "---- checking for runtime... "

      #
      # NOTE: Are we running inside Mono (regardless of operating system)?
      #
      if {[isTestMono]} then {
        #
        # NOTE: Yes, it appears that we are running inside Mono.
        #
        addConstraint mono; # running on Mono.

        tputs $channel [appendArgs [expr {[info exists \
            ::eagle_platform(runtime)] ? \
................................................................................

        #
        # NOTE: Now create a version string for use in the constraint name
        #       (remove the periods).
        #
        set version [string map [list . ""] $dotVersion]

        if {[isTestMono]} then {
          #
          # NOTE: If the runtime version was found, add a test constraint
          #       for it now.
          #
          if {[string length $version] > 0} then {
              #
              # NOTE: We are running on Mono.  Keep track of the specific
................................................................................
      tputs $channel "---- checking for database... "

      #
      # HACK: Disable database connectivity testing on Mono because
      #       it fails to timeout (unless special test suite hacks
      #       for Mono have been disabled by the user).
      #
      if {![isTestMono]} then {
        #
        # NOTE: Can we access the local database?
        #
        if {[catch {sql open -type $type $string} connection] == 0} then {
          #
          # NOTE: Yes, it appears that we can connect to the local database.
          #
................................................................................
        } else {
          tputs $channel unknown\n
        }
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForNetFx20ServicePack { channel } {
      tputs $channel "---- checking for .NET Framework 2.0 Service Pack... "

      #
      # NOTE: Platform must be Windows for this constraint to even be
      #       checked (i.e. we require the registry).
      #
      if {[isWindows]} then {
        #
        # NOTE: Registry hive where the .NET Framework 2.0 setup and
        #       servicing information is stored.  No need to look in
        #       the WoW64 registry because the .NET Framework should
        #       be installed natively as well.
        #
        set key [appendArgs HKEY_LOCAL_MACHINE\\ \
            {Software\Microsoft\NET Framework Setup\NDP\v2.0.50727}]

        #
        # NOTE: Attempt to fetch the .NET Framework 2.0 "SP" value from the
        #       servicing registry hive.  If this value does not exist -OR-
        #       is less than 1, then no .NET Framework 2.0 service pack is
        #       installed.  If this raises a script error, that will almost
        #       certainly cause the result to be a non-integer, this failing
        #       the check below.
        #
        catch {
          object invoke Microsoft.Win32.Registry GetValue $key SP null
        } servicePack

        if {[string is integer -strict $servicePack]} then {
          #
          # NOTE: Service packs are always cumulative; therefore, add test
          #       constraints for all service pack levels up to the one that
          #       is actually installed.
          #
          for {set level 0} {$level <= $servicePack} {incr level} {
            addConstraint [appendArgs dotNet20Sp $level OrHigher]
          }

          #
          # NOTE: Also add the "exact" service pack test constraint even
          #       though it should almost never be used.
          #
          addConstraint [appendArgs dotNet20Sp $servicePack]

          #
          # NOTE: Show the "servicePack" value we found in the registry.
          #
          tputs $channel [appendArgs "yes (" $servicePack ")\n"]

          #
          # NOTE: We are done here, return now.
          #
          return
        }
      }

      tputs $channel no\n
    }
 
    proc checkForNetFx45 { channel } {
      tputs $channel "---- checking for .NET Framework 4.5... "

      #
      # NOTE: Platform must be Windows for this constraint to even be
      #       checked (i.e. we require the registry).
................................................................................
        set key [appendArgs HKEY_LOCAL_MACHINE\\ \
            {Software\Microsoft\NET Framework Setup\NDP\v4\Full}]

        #
        # NOTE: Attempt to fetch the .NET Framework 4.0 "release" value from
        #       the servicing registry hive.  If this value does not exist
        #       -OR- is less than 378389, then the .NET Framework 4.5 is not
        #       installed.  If this raises a script error, that will almost
        #       certainly cause the result to be a non-integer, this failing
        #       the check below.
        #
        catch {
          object invoke Microsoft.Win32.Registry GetValue $key Release null
        } release

        if {[string is integer -strict $release] && $release >= 378389} then {
          #
          # NOTE: Yes, it appears that it is available.
          #
          addConstraint dotNet45OrHigher

          #
          # NOTE: If the "release" value is greater than or equal to 378758
          #       (or 378675 for Windows 8.1), then the .NET Framework 4.5.1
          #       is installed.  However, if the "release" value is also
          #       greater than or equal to 379893, then the .NET Framework
          #       4.5.2 is installed, which is an in-place upgrade to 4.5.1
          #       (and 4.5).
          #
          if {$release >= 379893} then {
            addConstraint dotNet452
            addConstraint dotNet452OrHigher

            set version 4.5.2
          } elseif {$release >= 378675} then {
            addConstraint dotNet451
            addConstraint dotNet451OrHigher

            set version 4.5.1
          } else {
            addConstraint dotNet45

................................................................................

    #
    # NOTE: We need several of our test constraint related commands in the
    #       global namespace.
    #
    exportAndImportPackageCommands [namespace current] [list \
        getKnownCompileOptions getKnownMonoVersions lpermute \
        alwaysFullInterpReady canExecWhoAmI canExecTclShell canExecFossil \
        isTestMono isTestAdministrator canPing checkForTestSuiteFiles \
        checkForPlatform checkForWindowsVersion checkForScriptLibrary \
        checkForVariable checkForTclOptions checkForWindowsCommandProcessor \
        checkForFossil checkForEagle checkForSymbols checkForLogFile \

        checkForGaruda checkForShell checkForDebug checkForTk checkForVersion \
        checkForCommand checkForNamespaces checkForTestExec \
        checkForTestMachine checkForTestPlatform checkForTestConfiguration \
        checkForTestSuffix checkForFile checkForPathFile checkForNativeCode \
        checkForTip127 checkForTip194 checkForTip207 checkForTip241 \
        checkForTip285 checkForTip405 checkForTip426 checkForTip429 \
        checkForTiming checkForPerformance checkForBigLists \
        checkForTimeIntensive checkForMemoryIntensive checkForStackIntensive \
        checkForInteractive checkForInteractiveCommand checkForUserInteraction \
        checkForNetwork checkForCompileOption checkForKnownCompileOptions] false false


    ###########################################################################
    ############################## END Tcl ONLY ###############################
    ###########################################################################
  }
 
  #
  # 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/epilogue.eagle.

151
152
153
154
155
156
157

158
159
160
161
162
163
164
            "==== test name \"" $name "\" BAD COUNT (" $count ")\n"]
      }
    }

    unset -nocomplain name count

    tputs $test_channel \n; # NOTE: Blank line.


    if {$eagle_tests(Passed) > 0} then {
      tresult Ok [appendArgs "PASSED: " $eagle_tests(Passed) \n]
    }

    if {$eagle_tests(Failed) > 0} then {
      tresult Error [appendArgs "FAILED: " $eagle_tests(Failed) \n]







>







151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
            "==== test name \"" $name "\" BAD COUNT (" $count ")\n"]
      }
    }

    unset -nocomplain name count

    tputs $test_channel \n; # NOTE: Blank line.
    reportTestConstraintCounts $test_channel $eagle_tests(SkippedNames)

    if {$eagle_tests(Passed) > 0} then {
      tresult Ok [appendArgs "PASSED: " $eagle_tests(Passed) \n]
    }

    if {$eagle_tests(Failed) > 0} then {
      tresult Error [appendArgs "FAILED: " $eagle_tests(Failed) \n]

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

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
...
300
301
302
303
304
305
306


307
308
309
310
311
312
313
...
399
400
401
402
403
404
405
















406
407
408
409
410
411
412
...
553
554
555
556
557
558
559
















560
561
562
563
564
565
566
...
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
....
1472
1473
1474
1475
1476
1477
1478














1479
1480
1481
1482
1483
1484
1485
1486
1487
1488

















1489
1490
1491
1492
1493
1494
1495
1496








1497
1498
1499
1500
1501
1502
1503
....
1784
1785
1786
1787
1788
1789
1790













1791
1792
1793
1794
1795
1796
1797
....
1961
1962
1963
1964
1965
1966
1967











1968
1969
1970
1971
1972
1973
1974
....
2463
2464
2465
2466
2467
2468
2469




2470
2471
2472
2473
2474
2475
2476
  if {[info level] > 0} then {
    error "cannot run, current level is not global"
  }

  #
  # NOTE: Make sure all the variables used by this prologue are unset.
  #
  unset -nocomplain pkg_dir pattern exec dummy directory name value expr \
      publicKeyToken encoding memory stack drive server database timeout \
      user password percent checkout timeStamp loaded

  #
  # NOTE: Indicate that the test suite is currently running.
  #
  if {![info exists test_suite_running] || !$test_suite_running} then {
    set test_suite_running true
................................................................................
  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.
  #
  if {[info exists argv]} then {
    eval processTestArguments test_flags $argv
................................................................................
    if {[info exists test_flags(-postTest)] && \
        [string length $test_flags(-postTest)] > 0} then {
      #
      # NOTE: Set the pre-test script to the one provided by the command line.
      #
      set test_script(post) $test_flags(-postTest)
    }
















  }

  #
  # NOTE: Set the default test suite name, if necessary.
  #
  if {![info exists test_suite]} then {
    set test_suite [getTestSuite]
................................................................................
      [appendArgs \" $test_script(pre) \"] : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- post-test script: " \
      [expr {[info exists test_script(post)] && \
      [string length $test_script(post)] > 0 ? \
      [appendArgs \" $test_script(post) \"] : "<none>"}] \n]

















  #
  # NOTE: Are we being prevented from evaluating the "pre-test" script?
  #
  if {![info exists no(preTest)]} then {
    #
    # NOTE: Evaluate the specified pre-test script now, if any.
    #
................................................................................

    #
    # NOTE: If the "no(mono)" variable is set (to anything) then any
    #       special test suite hacks for Mono will be disabled. This
    #       does not control or change any hacks for Mono that may
    #       be present in the library itself.
    #
    # if {![info exists no(mono)] && [isMono]} then {
    #   set no(mono) true
    # }

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

................................................................................
      }
    }

    #
    # NOTE: Has custom test method support been disabled?
    #
    if {![info exists no(core)] && ![info exists no(test)]} then {














      #
      # NOTE: Has script stream testing support been disabled?
      #
      if {![info exists no(testScriptStream)]} then {
        #
        # NOTE: For tests "basic-1.46" and "basic-1.47".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestScriptStream*
      }


















      if {![info exists no(testLoad)]} then {
        #
        # NOTE: For tests "load-1.6" and "load-1.7".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestLoadPluginViaBytes*
      }









      #
      # NOTE: Has DateTime testing support been disabled?
      #
      if {![info exists no(testDateTime)]} then {
        #
        # NOTE: For test "vwait-1.11".
................................................................................

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














        #
        # NOTE: For test "array-4.1".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestTwoByteArrays*

        checkForObjectMember $test_channel Eagle._Tests.Default \
................................................................................
    #
    if {![info exists no(powerShell)]} then {
      #
      # NOTE: For tests "object-4.7", "object-4.8", and "object-4.9".
      #
      checkForPowerShell $test_channel
    }












    #
    # NOTE: Has .NET Framework 4.5 testing support been disabled?
    #
    if {![info exists no(netFx45)]} then {
      #
      # NOTE: For test "object-12.1.*".
................................................................................
  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







|
|







 







>
>







 







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







 







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







 







|







 







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










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








>
>
>
>
>
>
>
>







 







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







 







>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
...
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
...
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
...
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
...
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
....
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
1544
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
1573
1574
1575
1576
....
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
....
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
....
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
  if {[info level] > 0} then {
    error "cannot run, current level is not global"
  }

  #
  # NOTE: Make sure all the variables used by this prologue are unset.
  #
  unset -nocomplain pkg_dir pattern dummy directory name value exec encoding \
      host memory stack drive publicKeyToken expr server database timeout \
      user password percent checkout timeStamp loaded

  #
  # NOTE: Indicate that the test suite is currently running.
  #
  if {![info exists test_suite_running] || !$test_suite_running} then {
    set test_suite_running true
................................................................................
  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(-preWait) ""; # default to not waiting.
  set test_flags(-postWait) ""; # default to not waiting.
  set test_flags(-tclsh) ""; # Tcl shell, default to empty.

  #
  # NOTE: Check for and process any command line arguments.
  #
  if {[info exists argv]} then {
    eval processTestArguments test_flags $argv
................................................................................
    if {[info exists test_flags(-postTest)] && \
        [string length $test_flags(-postTest)] > 0} then {
      #
      # NOTE: Set the pre-test script to the one provided by the command line.
      #
      set test_script(post) $test_flags(-postTest)
    }

    if {[info exists test_flags(-preWait)] && \
        [string is integer -strict $test_flags(-preWait)]} then {
      #
      # NOTE: Set the specified wait (in milliseconds) before each file.
      #
      set test_wait(pre) $test_flags(-preWait)
    }

    if {[info exists test_flags(-postWait)] && \
        [string is integer -strict $test_flags(-postWait)]} then {
      #
      # NOTE: Set the specified wait (in milliseconds) after each file.
      #
      set test_wait(post) $test_flags(-postWait)
    }
  }

  #
  # NOTE: Set the default test suite name, if necessary.
  #
  if {![info exists test_suite]} then {
    set test_suite [getTestSuite]
................................................................................
      [appendArgs \" $test_script(pre) \"] : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- post-test script: " \
      [expr {[info exists test_script(post)] && \
      [string length $test_script(post)] > 0 ? \
      [appendArgs \" $test_script(post) \"] : "<none>"}] \n]

  #
  # NOTE: Show both the pre-test and post-test waits now, prior to actually
  #       using either of them (even if their use has been disabled).
  #
  tputs $test_channel [appendArgs "---- pre-test wait: " \
      [expr {[info exists test_wait(pre)] && \
      [string is integer -strict $test_wait(pre)] ? \
      [appendArgs $test_wait(pre) " milliseconds"] : \
      "<none>"}] \n]

  tputs $test_channel [appendArgs "---- post-test wait: " \
      [expr {[info exists test_wait(post)] && \
      [string is integer -strict $test_wait(post)] ? \
      [appendArgs $test_wait(post) " milliseconds"] : \
      "<none>"}] \n]

  #
  # NOTE: Are we being prevented from evaluating the "pre-test" script?
  #
  if {![info exists no(preTest)]} then {
    #
    # NOTE: Evaluate the specified pre-test script now, if any.
    #
................................................................................

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

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

................................................................................
      }
    }

    #
    # NOTE: Has custom test method support been disabled?
    #
    if {![info exists no(core)] && ![info exists no(test)]} then {
      #
      # NOTE: Has plugin policy testing support been disabled?
      #
      if {![info exists no(testPluginPolicy)]} then {
        #
        # NOTE: For tests "load-2.0" and "load-2.1".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestAddLoadPluginPolicy*

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

      #
      # NOTE: Has script stream testing support been disabled?
      #
      if {![info exists no(testScriptStream)]} then {
        #
        # NOTE: For tests "basic-1.46" and "basic-1.47".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestScriptStream*
      }

      #
      # NOTE: Has complaint testing support been disabled?
      #
      if {![info exists no(testComplain)]} then {
        #
        # NOTE: For tests "debug-1.98" and "debug-1.99".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestSetComplainCallback*

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

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

      if {![info exists no(testLoad)]} then {
        #
        # NOTE: For tests "load-1.6" and "load-1.7".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestLoadPluginViaBytes*
      }

      if {![info exists no(testPermute)]} then {
        #
        # NOTE: For test "lpermute-1.3".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestPermute*
      }

      #
      # NOTE: Has DateTime testing support been disabled?
      #
      if {![info exists no(testDateTime)]} then {
        #
        # NOTE: For test "vwait-1.11".
................................................................................

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

        #
        # NOTE: For tests "basic-1.66", "basic-1.67", "basic-1.68",
        #       and "basic-1.69".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestTakeEventHandler*

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

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

        #
        # NOTE: For test "array-4.1".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestTwoByteArrays*

        checkForObjectMember $test_channel Eagle._Tests.Default \
................................................................................
    #
    if {![info exists no(powerShell)]} then {
      #
      # NOTE: For tests "object-4.7", "object-4.8", and "object-4.9".
      #
      checkForPowerShell $test_channel
    }

    #
    # NOTE: Has .NET Framework 2.0 Service Pack testing support been
    #       disabled?
    #
    if {![info exists no(netFx20Sp)]} then {
      #
      # NOTE: For test "hash-1.1".
      #
      checkForNetFx20ServicePack $test_channel
    }

    #
    # NOTE: Has .NET Framework 4.5 testing support been disabled?
    #
    if {![info exists no(netFx45)]} then {
      #
      # NOTE: For test "object-12.1.*".
................................................................................
  if {![info exists no(tclOptions)]} then {
    checkForTclOptions $test_channel
  }

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

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

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

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