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

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

Overview
Comment:Update Eagle in externals to the official beta 19 release.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: d598ffd54624b6829230941ddcabbf11e8fa85fd
User & Date: mistachkin 2011-10-23 08:58:31
Context
2011-10-29
21:16
Fix error checking by portions of the batch tools that create missing directories on an as-needed basis. check-in: 299d71992b user: mistachkin tags: trunk
2011-10-23
08:58
Update Eagle in externals to the official beta 19 release. check-in: d598ffd546 user: mistachkin tags: trunk
02:33
Add the external tools needed to build the documentation. check-in: 418f5dab8c user: mistachkin tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace 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/lib/Eagle1.0/init.eagle.

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
1577
1578
      #
      # NOTE: This should work properly in Tcl only.
      #
      # NOTE: Forget any previous commands that were imported from this
      #       namespace into the global namespace?
      #
      if {$forget} then {
        namespace forget ${namespace}::*
      }

      #
      # NOTE: Process each of the commands to be exported from this
      #       namespace and import it into the global namespace, if
      #       necessary.
      #
      foreach export $exports {
        #
        # NOTE: Force importing of our exported commands into the
        #       global namespace?  Otherwise, see if the command is
        #       already present in the global namespace before trying
        #       to import it.
        #
        if {$force || [llength [info commands ::$export]] == 0} then {
          namespace export $export










          if {$force} then {
            namespace eval :: [list namespace import -force \
                ${namespace}::$export]
          } else {
            namespace eval :: [list namespace import \
                ${namespace}::$export]
          }
        }
      }
    }
 
    #
    # NOTE: Exports the necessary commands from this package and import
    #       them into the global namespace.
    #
    exportAndImportPackageCommands [namespace current] [list \
        exportAndImportPackageCommands isEagle isMono getEnvironmentVariable \
        getPluginPath getDictionaryValue getColumnValue getRowColumnValue \
        appendArgs haveGaruda lappendArgs readFile filter map reduce \
        getPlatformInfo execShell] false false








|



|





|
|
|
|

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

|
<

|
<






|
|







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
1577
1578
1579
1580
1581
1582
1583
1584
1585
      #
      # NOTE: This should work properly in Tcl only.
      #
      # NOTE: Forget any previous commands that were imported from this
      #       namespace into the global namespace?
      #
      if {$forget} then {
        namespace eval :: [list namespace forget [appendArgs $namespace ::*]]
      }

      #
      # NOTE: Process each command to be exported from the specified
      #       namespace and import it into the global namespace, if
      #       necessary.
      #
      foreach export $exports {
        #
        # NOTE: Force importing of our exported commands into the global
        #       namespace?  Otherwise, see if the command is already
        #       present in the global namespace before trying to import
        #       it.
        #
        if {$force || \
            [llength [info commands [appendArgs :: $export]]] == 0} then {
          #
          # NOTE: Export the specified command from the specified namespace.
          #
          namespace eval $namespace [list namespace export $export]

          #
          # NOTE: Import the specified command into the global namespace.
          #
          set namespaceExport [appendArgs $namespace :: $export]

          if {$force} then {
            namespace eval :: [list namespace import -force $namespaceExport]

          } else {
            namespace eval :: [list namespace import $namespaceExport]

          }
        }
      }
    }
 
    #
    # NOTE: Exports the necessary commands from this package and import them
    #       into the global namespace.
    #
    exportAndImportPackageCommands [namespace current] [list \
        exportAndImportPackageCommands isEagle isMono getEnvironmentVariable \
        getPluginPath getDictionaryValue getColumnValue getRowColumnValue \
        appendArgs haveGaruda lappendArgs readFile filter map reduce \
        getPlatformInfo execShell] false false

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

168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
...
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
...
711
712
713
714
715
716
717
718
719
720
721


722
723
724
725
726
727
728
...
729
730
731
732
733
734
735











736
737
738
739
740
741
742
...
874
875
876
877
878
879
880
881
882
883

884
885
886
887
888
889
890
....
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
....
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121




1122
1123
1124
1125
1126
1127
1128
....
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254



1255
1256
1257
1258
1259
1260


1261




1262
1263
1264

1265



1266

1267





1268
1269
1270
1271
1272

1273

1274
1275
1276
1277
1278
1279
1280
1281
1282
1283




1284
1285
1286
1287









































































1288
1289
1290
1291
1292
1293

1294
1295

1296

1297
1298
1299
1300
1301
1302
1303
1304
1305

1306
1307





1308
1309
1310
1311
1312
1313
1314
 
  proc sourceIfValid { type fileName } {
    if {[string length $fileName] > 0} then {
      if {[file exists $fileName]} then {
        tputs $::test_channel [appendArgs \
            "---- evaluating $type file: \"" $fileName \"\n]

        if {[catch {uplevel 1 [list source $fileName]} error] != 0} then {
          tputs $::test_channel [appendArgs \
              "---- error during $type file: " $error \n]

          #
          # NOTE: The error has been logged, now re-throw it.
          #
          error $error $::errorInfo $::errorCode
................................................................................

      catch {set array(tclinterps,$index) [llength [tcl interps]]}
      catch {set array(tclthreads,$index) [llength [tcl threads]]}
      catch {set array(tclcommands,$index) [llength [tcl command list]]}
    }
  }
 
  proc reportTestStatistics { channel fileName varName } {
    set statistics [list afters variables commands procedures files \
        temporaryFiles channels aliases interpreters environment]

    if {[isEagle]} then {
      #
      # TODO: For now, tracking "leaked" assemblies is meaningless because
      #       the .NET Framework has no way to unload them without tearing
................................................................................
          namespaces processes connections transactions modules \
          delegates tcl tclinterps tclthreads tclcommands; # assemblies
    }

    #
    # NOTE: Show what leaked, if anything.
    #
    upvar 1 $varName array

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


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

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

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











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

    foreach item $list {
................................................................................

    #
    # NOTE: So far, we have run no tests.
    #
    set count 0

    #
    # NOTE: So far, no files have had no files with failing tests.
    #
    set failed [list]


    #
    # NOTE: Process each file name we have been given by the caller...
    #
    set total [llength $fileNames]; set lastPercent -1

    foreach fileName $fileNames {
................................................................................
            #
            recordTestStatistics leaks after

            #
            # NOTE: Determine if any resource leaks have occurred and
            #       output diagnostics as necessary if they have.
            #
            reportTestStatistics $channel $fileName leaks
          }
        } else {
          #
          # NOTE: This file does not actually count towards the total (i.e.
          #       it contains no actual tests).
          #
          incr total -1
................................................................................
    #
    clearTestPercent $channel

    tputs $channel [appendArgs "---- sourced " $count " test " \
        [expr {$count > 1 ? "files" : "file"}] \n]

    #
    # NOTE: Show the files that had failing tests.
    #
    if {[llength $failed] > 0} then {
      tputs $channel [appendArgs "---- files with failing tests: " $failed \n]
    }




  }
 
  proc configureTcltest { imports force } {
    if {[isEagle]} then {
      #
      # NOTE: Fake having the tcltest package.
      #
................................................................................
            {100.0 * ($::eagle_tests(skipped) / \
            double($::eagle_tests(total)))}]
      }

      return 0; # no tests were run, etc.
    }
 
    proc cleanupThread { thread } {
      if {[$thread IsAlive]} then {
        if {[catch {$thread Interrupt} error]} then {
          tputs $::test_channel [appendArgs \
              "---- failed to interrupt test thread \"" \
              $thread "\": " $error \n]



        }

        if {[$thread IsAlive]} then {
          if {[catch {$thread Abort} error]} then {
            tputs $::test_channel [appendArgs \
                "---- failed to abort test thread \"" \


                $thread "\": " $error \n]




          }

          if {![$thread IsAlive]} then {

            tputs $::test_channel [appendArgs \



                "---- test thread \"" $thread "\" aborted\n"]







            return true; # aborted?
          }
        } else {
          tputs $::test_channel [appendArgs \
              "---- test thread \"" $thread "\" interrupted\n"]



          return true; # interrupted?
        }
      } else {
        return true; # already dead?
      }

      return false; # still alive (or error).
    }
 
    proc calculateBogoCops { {milliseconds 2000} } {




      set bgerror [interp bgerror {}]
      interp bgerror {} ""

      try {









































































        set flags [after flags]
        after flags =Immediate

        try {
          set event [after $milliseconds [list interp cancel]]


          set before [info cmdcount]
          catch {time {nop} -1}; # internal busy loop.

          set after [info cmdcount]


          #
          # HACK: Mono has a bug that results in excessive trailing zeros
          #       here (Mono bug #655780).
          #
          if {[isMono]} then {
            return [expr \
                {double(($after - $before) / ($milliseconds / 1000.0))}]
          } else {

            return [expr {($after - $before) / ($milliseconds / 1000.0)}]
          }





        } finally {
          if {[info exists event]} then {
            catch {after cancel $event}
          }

          after flags =$flags
        }







|







 







|







 







|



>
>







 







>
>
>
>
>
>
>
>
>
>
>







 







|


>







 







|







 







|




>
>
>
>







 







|



|
|
>
>
>



|

|
>
>
|
>
>
>
>


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










>
>
>
>




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




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







168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
...
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
...
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
...
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
...
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
....
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
....
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
....
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
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
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
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
1404
1405

1406
1407
1408

1409
1410
1411
1412
1413

1414
1415
1416
1417
1418

1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
 
  proc sourceIfValid { type fileName } {
    if {[string length $fileName] > 0} then {
      if {[file exists $fileName]} then {
        tputs $::test_channel [appendArgs \
            "---- evaluating $type file: \"" $fileName \"\n]

        if {[catch {uplevel 1 [list source $fileName]} error]} then {
          tputs $::test_channel [appendArgs \
              "---- error during $type file: " $error \n]

          #
          # NOTE: The error has been logged, now re-throw it.
          #
          error $error $::errorInfo $::errorCode
................................................................................

      catch {set array(tclinterps,$index) [llength [tcl interps]]}
      catch {set array(tclthreads,$index) [llength [tcl threads]]}
      catch {set array(tclcommands,$index) [llength [tcl command list]]}
    }
  }
 
  proc reportTestStatistics { channel fileName statsVarName filesVarName } {
    set statistics [list afters variables commands procedures files \
        temporaryFiles channels aliases interpreters environment]

    if {[isEagle]} then {
      #
      # TODO: For now, tracking "leaked" assemblies is meaningless because
      #       the .NET Framework has no way to unload them without tearing
................................................................................
          namespaces processes connections transactions modules \
          delegates tcl tclinterps tclthreads tclcommands; # assemblies
    }

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

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

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

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

    #
    # NOTE: Make sure this file name is recorded in the list of file names with
    #       leaking tests.
    #
    upvar 1 $filesVarName fileNames

    if {$count > 0 && \
        [lsearch -exact $fileNames [file tail $fileName]] == -1} then {
      lappend fileNames [file tail $fileName]
    }
  }
 
  proc formatList { list {default ""} {columns 1} } {
    set count 1
    set result ""

    foreach item $list {
................................................................................

    #
    # NOTE: So far, we have run no tests.
    #
    set count 0

    #
    # NOTE: So far, no files have had failing or leaking tests.
    #
    set failed [list]
    set leaked [list]

    #
    # NOTE: Process each file name we have been given by the caller...
    #
    set total [llength $fileNames]; set lastPercent -1

    foreach fileName $fileNames {
................................................................................
            #
            recordTestStatistics leaks after

            #
            # NOTE: Determine if any resource leaks have occurred and
            #       output diagnostics as necessary if they have.
            #
            reportTestStatistics $channel $fileName leaks leaked
          }
        } else {
          #
          # NOTE: This file does not actually count towards the total (i.e.
          #       it contains no actual tests).
          #
          incr total -1
................................................................................
    #
    clearTestPercent $channel

    tputs $channel [appendArgs "---- sourced " $count " test " \
        [expr {$count > 1 ? "files" : "file"}] \n]

    #
    # NOTE: Show the files that had failing and/or leaking tests.
    #
    if {[llength $failed] > 0} then {
      tputs $channel [appendArgs "---- files with failing tests: " $failed \n]
    }

    if {[llength $leaked] > 0} then {
      tputs $channel [appendArgs "---- files with leaking tests: " $leaked \n]
    }
  }
 
  proc configureTcltest { imports force } {
    if {[isEagle]} then {
      #
      # NOTE: Fake having the tcltest package.
      #
................................................................................
            {100.0 * ($::eagle_tests(skipped) / \
            double($::eagle_tests(total)))}]
      }

      return 0; # no tests were run, etc.
    }
 
    proc cleanupThread { thread {timeout 2000} } {
      if {[$thread IsAlive]} then {
        if {[catch {$thread Interrupt} error]} then {
          tputs $::test_channel [appendArgs \
              "---- failed to interrupt test thread \"" $thread "\": " $error \
              \n]
        } else {
          tputs $::test_channel [appendArgs "---- test thread \"" $thread \
              "\" interrupted\n"]
        }

        if {[$thread IsAlive]} then {
          if {[catch {$thread Join $timeout} error]} then {
            tputs $::test_channel [appendArgs \
                "---- failed to join test thread \"" $thread "\": " $error \n]
          } elseif {$error} then {
            tputs $::test_channel [appendArgs "---- joined test thread \"" \
                $thread \"\n]
          } else {
            tputs $::test_channel [appendArgs \
                "---- timeout joining test thread \"" $thread " (" $timeout \
                " milliseconds)\"\n"]
          }

          if {[$thread IsAlive]} then {
            if {[catch {$thread Abort} error]} then {
              tputs $::test_channel [appendArgs \
                  "---- failed to abort test thread \"" $thread "\": " $error \
                  \n]
            } else {
              tputs $::test_channel [appendArgs "---- test thread \"" $thread \
                  "\" aborted\n"]
            }

            if {[$thread IsAlive]} then {
              tputs $::test_channel [appendArgs "---- test thread \"" $thread \
                  "\" appears to be a zombie\n"]
            } else {
              return true; # aborted?
            }
          } else {


            return true; # joined?
          }
        } else {
          return true; # interrupted?
        }
      } else {
        return true; # already dead?
      }

      return false; # still alive (or error).
    }
 
    proc calculateBogoCops { {milliseconds 2000} } {
      #
      # NOTE: Save the current background error handler for later restoration
      #       and then reset the current background error handler to nothing.
      #
      set bgerror [interp bgerror {}]
      interp bgerror {} ""

      try {
        #
        # NOTE: Save the current [after] flags for later restoration and then
        #       reset them to process events immediately.
        #
        set flags [after flags]
        after flags =Immediate

        try {
          set code [catch {
            #
            # NOTE: Schedule the event to cancel the script we are about to
            #       evaluate, capturing the name so we can cancel it later, if
            #       necessary.
            #
            set event [after $milliseconds [list interp cancel]]

            #
            # HACK: There is the potential for a "race condition" here.  If the
            #       specified number of milliseconds elapses before (or after)
            #       entering the [catch] script block (below) then the resulting
            #       script cancellation error will not be caught and we will be
            #       unable to return the correct result to the caller.
            #
            set before [info cmdcount]
            catch {time {nop} -1}; # uses the [time] internal busy loop.
            set after [info cmdcount]

            #
            # HACK: Mono has a bug that results in excessive trailing zeros
            #       here (Mono bug #655780).
            #
            if {[isMono]} then {
              expr {double(($after - $before) / ($milliseconds / 1000.0))}
            } else {
              expr {($after - $before) / ($milliseconds / 1000.0)}
            }
          } result]

          #
          # NOTE: If we failed to calculate the number of commands-per-second
          #       due to some subtle race condition [as explained above], return
          #       an obviously invalid result instead.
          #
          if {$code == 0} then {
            return $result
          } else {
            return 0
          }
        } finally {
          if {[info exists event]} then {
            catch {after cancel $event}
          }

          after flags =$flags
        }
      } finally {
        interp bgerror {} $bgerror
      }
    }
 
    proc evalWithTimeout { script {milliseconds 2000} {resultVarName ""} } {
      #
      # NOTE: Save the current background error handler for later restoration
      #       and then reset the current background error handler to nothing.
      #
      set bgerror [interp bgerror {}]
      interp bgerror {} ""

      try {
        #
        # NOTE: Save the current [after] flags for later restoration and then
        #       reset them to process events immediately.
        #
        set flags [after flags]
        after flags =Immediate

        try {

          #
          # NOTE: Evaluate the specified script in the context of the caller,
          #       returning the result to the caller.

          #
          if {[string length $resultVarName] > 0} then {
            upvar 1 $resultVarName result
          }


          return [catch {
            #
            # NOTE: Schedule the event to cancel the script we are about to
            #       evaluate, capturing the name so we can cancel it later, if
            #       necessary.

            #
            set event [after $milliseconds [list interp cancel]]

            #
            # NOTE: Evaluate the script in the context of the caller.
            #
            uplevel 1 $script
          } result]
        } finally {
          if {[info exists event]} then {
            catch {after cancel $event}
          }

          after flags =$flags
        }

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

121
122
123
124
125
126
127






















128
129
130
131
132
133
134
...
531
532
533
534
535
536
537
538
539
540
541
542


543
544

545
546
547
548
549
550
551
...
555
556
557
558
559
560
561



562
563
564
565
566
567
568
569
570



571
572




573
574
575
576
577
578
579
....
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
      if {![info exists ::no(compileNetwork)]} then {
        addConstraint compile.NETWORK
      }

      tputs $channel no\n
    }
  }






















 
  proc checkForLogFile { channel } {
    tputs $channel "---- checking for log file... "

    if {[info exists ::test_log] && \
        [string length $::test_log] > 0 && \
        [file exists $::test_log]} then {
................................................................................

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForTiming { channel threshold } {
    tputs $channel "---- checking for precision timing... "

    #
    # NOTE: Are we allowed to do precision timing tests?


    #
    if {![info exists ::no(timing)]} then {

      #
      # NOTE: Attempt to block for exactly one second.
      #
      set start [expr {[clock clicks -milliseconds] & 0x7fffffff}]
      after 1000; # wait for "exactly" one second.
      set stop [expr {[clock clicks -milliseconds] & 0x7fffffff}]

................................................................................
      #
      set difference [expr {abs($stop - $start - 1000)}]

      #
      # NOTE: Are we within the threshold specified by the caller?
      #
      if {$difference >= 0 && $difference <= $threshold} then {



        addConstraint timing

        tputs $channel [appendArgs "yes (0 <= " $difference " <= " \
            $threshold " milliseconds)\n"]
      } else {
        tputs $channel [appendArgs "no (0 <= " $difference " > " \
            $threshold " milliseconds)\n"]
      }
    } else {



      tputs $channel no\n
    }




  }
 
  proc checkForPerformance { channel } {
    tputs $channel "---- checking for performance testing... "

    #
    # NOTE: Are we allowed to do performance testing?
................................................................................
    # NOTE: We need several of our test constraint related commands in the
    #       global namespace.
    #
    exportAndImportPackageCommands [namespace current] [list checkForPlatform \
        checkForEagle checkForGaruda checkForShell checkForDebug checkForTk \
        checkForVersion checkForCommand checkForFile checkForNativeCode \
        checkForTip127 checkForTip194 checkForTip241 checkForTip285 \
        checkForPerformance checkForTiming checkForInteractive checkForLogFile \
        checkForNetwork checkForCompileOption checkForUserInteraction] false \
        false

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







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







 







|



|
>
>

<
>







 







>
>
>



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







 







|
|
|













121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
...
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567

568
569
570
571
572
573
574
575
...
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
....
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
      if {![info exists ::no(compileNetwork)]} then {
        addConstraint compile.NETWORK
      }

      tputs $channel no\n
    }
  }
 
  proc checkForSymbols { channel name {constraint ""} } {
    set fileName [file normalize [appendArgs [file rootname $name] .pdb]]

    tputs $channel [appendArgs "---- checking for symbols \"" $fileName \
        "\"... "]

    if {[file exists $fileName]} then {
      #
      # NOTE: The file appears to have associated symbols available.
      #
      if {[string length $constraint] > 0} then {
        addConstraint [appendArgs symbols_ $constraint]
      } else {
        addConstraint [appendArgs symbols_ [file tail $name]]
      }

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForLogFile { channel } {
    tputs $channel "---- checking for log file... "

    if {[info exists ::test_log] && \
        [string length $::test_log] > 0 && \
        [file exists $::test_log]} then {
................................................................................

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }
 
  proc checkForTiming { channel threshold {tries 2} } {
    tputs $channel "---- checking for precision timing... "

    #
    # HACK: Sometimes the first try takes quite a bit longer than subsequent
    #       tries.  We attempt to bypass this problem by retrying a set number
    #       of times (which can be overridden by the caller) before giving up.
    #

    for {set try 0} {$try < $tries} {incr try} {
      #
      # NOTE: Attempt to block for exactly one second.
      #
      set start [expr {[clock clicks -milliseconds] & 0x7fffffff}]
      after 1000; # wait for "exactly" one second.
      set stop [expr {[clock clicks -milliseconds] & 0x7fffffff}]

................................................................................
      #
      set difference [expr {abs($stop - $start - 1000)}]

      #
      # NOTE: Are we within the threshold specified by the caller?
      #
      if {$difference >= 0 && $difference <= $threshold} then {
        #
        # NOTE: We appear to be capable of fairly precise timing.
        #
        addConstraint timing

        tputs $channel [appendArgs "yes (0 <= " $difference " <= " \
            $threshold " milliseconds, tried " [expr {$try + 1}] \
            " " [expr {$try > 0 ? "times" : "time"}] ")\n"]




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

    tputs $channel [appendArgs "no (0 <= " $difference " > " \
        $threshold " milliseconds)\n"]
  }
 
  proc checkForPerformance { channel } {
    tputs $channel "---- checking for performance testing... "

    #
    # NOTE: Are we allowed to do performance testing?
................................................................................
    # NOTE: We need several of our test constraint related commands in the
    #       global namespace.
    #
    exportAndImportPackageCommands [namespace current] [list checkForPlatform \
        checkForEagle checkForGaruda checkForShell checkForDebug checkForTk \
        checkForVersion checkForCommand checkForFile checkForNativeCode \
        checkForTip127 checkForTip194 checkForTip241 checkForTip285 \
        checkForPerformance checkForTiming checkForInteractive checkForSymbols \
        checkForLogFile checkForNetwork checkForCompileOption \
        checkForUserInteraction] false false

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

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

46
47
48
49
50
51
52


53
54
55
56
57
58
59
60
61
62
63

64
65
66


67
68
69
70
71
72
73
..
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
...
654
655
656
657
658
659
660







661
662
663
664
665
666
667
...
827
828
829
830
831
832
833










834
835
836
837
838
839
840
....
1469
1470
1471
1472
1473
1474
1475




1476
1477
1478
1479
1480
1481
1482
....
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
    #       sub-directory inside of the "Library" project directory
    #       simply due to the links contained in the project file that
    #       actually point to the "lib\Eagle1.0" sub-directory under the
    #       solution directory.
    #
    # WARNING: The Eagle package name and version are hard-coded here.
    #


    if {![file exists [file join $base_path lib]] || \
        ![file isdirectory [file join $base_path lib]] || \
        ![file exists [file join $base_path lib Eagle1.0]] || \
        ![file isdirectory [file join $base_path lib Eagle1.0]] || \
        ![file exists [file join $base_path lib Eagle1.0 init.eagle]] || \
        ![file isfile [file join $base_path lib Eagle1.0 init.eagle]]} then {
      #
      # NOTE: We do not bother to check if the "lib" sub-directory
      #       actually exists as a child of this one.  This is the
      #       previous (legacy) behavior (i.e. where we always went
      #       up two levels to the base directory).

      #
      set base_path [file dirname $base_path]
    }


  }

  #
  # NOTE: Set the local root directory of the source checkout (i.e. of
  #       Eagle or whatever project the Eagle binaries are being used by).
  #
  if {![info exists root_path]} then {
................................................................................
      # NOTE: We extracted the local root directory of the source checkout
      #       from Fossil.  Now, make sure it is fully normalized and has no
      #       trailing slashes.
      #
      set root_path [file normalize $directory]
    }

    unset -nocomplain directory exec pattern
  }

  #
  # NOTE: Set the executable file name for the process, if
  #       necessary.
  #
  if {![info exists bin_file]} then {
................................................................................
      #
      # NOTE: Can we access the local database?
      #
      checkForDatabase $test_channel $test_database
      unset password user timeout database server
    }








    #
    # 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".
................................................................................
      #
      if {![info exists no(compileXml)]} then {
        #
        # NOTE: For tests "commands-1.4", "object-7.3" and "xml-1.1.*".
        #
        checkForCompileOption $test_channel XML
      }











      #
      # NOTE: Has dedicated test support been enabled (at compile-time)?
      #
      if {![info exists no(compileTest)]} then {
        #
        # NOTE: For tests "basic-1.20", "basic-1.21", "function-1.1",
................................................................................
  if {![info exists no(eagle)]} then {
    checkForEagle $test_channel
  }

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





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

  if {![info exists no(shell)]} then {
    checkForShell $test_channel
................................................................................

      if {[isMono]} then {
        #
        # HACK: We need something to go into the log file.
        #
        set timeStamp [lindex $timeStamp 0]
      } else {
        set timeStamp [clock format [clock scan $timeStamp] -iso]
      }
    } else {
      set timeStamp <none>
    }

    tputs $test_channel [appendArgs "---- build: " \
        [list [getPlatformInfo engine <none>]] " " \







>
>


|
|
|
|

|
|
|
<
>



>
>







 







|







 







>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>







 







>
>
>
>







 







|







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64

65
66
67
68
69
70
71
72
73
74
75
76
77
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
...
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
...
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
....
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
....
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
    #       sub-directory inside of the "Library" project directory
    #       simply due to the links contained in the project file that
    #       actually point to the "lib\Eagle1.0" sub-directory under the
    #       solution directory.
    #
    # WARNING: The Eagle package name and version are hard-coded here.
    #
    set pkg_dir Eagle1.0; # TODO: Change me.

    if {![file exists [file join $base_path lib]] || \
        ![file isdirectory [file join $base_path lib]] || \
        ![file exists [file join $base_path lib $pkg_dir]] || \
        ![file isdirectory [file join $base_path lib $pkg_dir]] || \
        ![file exists [file join $base_path lib $pkg_dir init.eagle]] || \
        ![file isfile [file join $base_path lib $pkg_dir init.eagle]]} then {
      #
      # NOTE: We do not bother to check if the "lib" sub-directory actually
      #       exists as a child of this one.  This is the previous (legacy)
      #       behavior (i.e. where we always went up two levels to the base

      #       directory).
      #
      set base_path [file dirname $base_path]
    }

    unset pkg_dir
  }

  #
  # NOTE: Set the local root directory of the source checkout (i.e. of
  #       Eagle or whatever project the Eagle binaries are being used by).
  #
  if {![info exists root_path]} then {
................................................................................
      # NOTE: We extracted the local root directory of the source checkout
      #       from Fossil.  Now, make sure it is fully normalized and has no
      #       trailing slashes.
      #
      set root_path [file normalize $directory]
    }

    unset -nocomplain directory dummy exec pattern
  }

  #
  # NOTE: Set the executable file name for the process, if
  #       necessary.
  #
  if {![info exists bin_file]} then {
................................................................................
      #
      # NOTE: Can we access the local database?
      #
      checkForDatabase $test_channel $test_database
      unset password user timeout database server
    }

    #
    # 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".
................................................................................
      #
      if {![info exists no(compileXml)]} then {
        #
        # NOTE: For tests "commands-1.4", "object-7.3" and "xml-1.1.*".
        #
        checkForCompileOption $test_channel XML
      }

      #
      # NOTE: Has serialization support been enabled (at compile-time)?
      #
      if {![info exists no(compileSerialization)]} then {
        #
        # NOTE: For test "interp-1.10".
        #
        checkForCompileOption $test_channel SERIALIZATION
      }

      #
      # NOTE: Has dedicated test support been enabled (at compile-time)?
      #
      if {![info exists no(compileTest)]} then {
        #
        # NOTE: For tests "basic-1.20", "basic-1.21", "function-1.1",
................................................................................
  if {![info exists no(eagle)]} then {
    checkForEagle $test_channel
  }

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

  if {![info exists no(symbols)]} then {
    checkForSymbols $test_channel [info nameofexecutable]
  }

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

  if {![info exists no(shell)]} then {
    checkForShell $test_channel
................................................................................

      if {[isMono]} then {
        #
        # HACK: We need something to go into the log file.
        #
        set timeStamp [lindex $timeStamp 0]
      } else {
        set timeStamp [clock format [clock scan $timeStamp] -iso -isotimezone]
      }
    } else {
      set timeStamp <none>
    }

    tputs $test_channel [appendArgs "---- build: " \
        [list [getPlatformInfo engine <none>]] " " \