Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Update Eagle script library in externals to the latest trunk code. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
8130180a1d34d6c96d325b758c433be6 |
| User & Date: | mistachkin 2015-10-19 02:15:18 |
Context
|
2015-10-19
| ||
| 17:23 | Add memory usage stress test. check-in: 67d28724d6 user: mistachkin tags: trunk | |
| 04:50 | Initial work on memory usage stress test. check-in: 7dd94a2532 user: mistachkin tags: memoryUsage | |
| 02:15 | Update Eagle script library in externals to the latest trunk code. check-in: 8130180a1d user: mistachkin tags: trunk | |
|
2015-10-18
| ||
| 21:45 | Update version history docs. check-in: 3efbff1ab2 user: mistachkin tags: trunk | |
Changes
Changes to Externals/Eagle/lib/Eagle1.0/init.eagle.
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
....
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
|
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
................................................................................
#
# 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.
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
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
....
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
|
proc runUpdateAndExit { {automatic false} } {
set directory [file dirname [info nameofexecutable]]
set command [list exec -shell -- \
[file join $directory Hippogriff.exe] -delay 2000]
#
# HACK: The native StrongNameSignatureVerificationEx() function does
# not appear to work on WOA (Windows-on-ARM) on the Surface RT
# tablet; therefore, attempt to disable its use when calling
# into the updater on that platform.
#
if {[isWindows] && \
[info exists ::tcl_platform(machine)] && \
$::tcl_platform(machine) eq "arm"} then {
#
# NOTE: We appear to be running on WOA (Windows-on-ARM), add the
# command line option that skips strong name verification.
#
lappend command -noStrongNameSigned true
}
#
# NOTE: If requested, enable fully automatic update mode.
#
if {$automatic} then {
lappend command -silent true -confirm false
}
set baseUri [getUpdateBaseUri]
if {[string length $baseUri] > 0} then {
lappend command -baseUri $baseUri
}
set pathAndQuery [getUpdatePathAndQuery]
if {[string length $pathAndQuery] > 0} then {
lappend command -tagPathAndQuery $pathAndQuery
}
eval $command &; exit -force
}
proc getUpdateBaseUri {} {
#
# NOTE: Check the current base URI for updates against the one baked
................................................................................
#
# NOTE: Ok, they are both valid. Are they different?
#
if {$baseUri(0) ne $baseUri(1)} then {
return $baseUri(0)
}
}
return ""
}
proc getUpdatePathAndQuery {} {
#
# NOTE: Check the current tag path and query for updates against the
# one baked into the assembly. If they are different, then the
# tag path and query must have been overridden. In that case,
# we must return the current tag path and query; otherwise, we
# must return an empty string.
#
set pathAndQuery(0) [info engine UpdatePathAndQuery \
false]; # NOTE: Current.
set pathAndQuery(1) [info engine UpdatePathAndQuery \
true]; # NOTE: Default.
if {[string length $pathAndQuery(0)] > 0 && \
[string length $pathAndQuery(1)] > 0} then {
#
# NOTE: Ok, they are both valid. Are they different?
#
if {$pathAndQuery(0) ne $pathAndQuery(1)} then {
return $pathAndQuery(0)
}
}
return ""
}
proc getUpdateData { uri } {
#
# NOTE: Start trusting ONLY our own self-signed SSL certificate.
|
Changes to Externals/Eagle/lib/Eagle1.0/test.eagle.
2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 |
#
set eagle_tests(Constraints) [getEnvironmentVariable testConstraints]
if {[info exists test_flags(-constraints)]} then {
eval lappend eagle_tests(Constraints) $test_flags(-constraints)
}
unset -nocomplain test_verbose; set test_verbose Default
if {[info exists test_flags(-verbose)] && \
[string length $test_flags(-verbose)] > 0} then {
#
# NOTE: Map all test verbosity flags we support for script usage
# to their abbreviated names (which are all one letter) and
# then split them into a list.
|
| > > > > > |
2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 |
#
set eagle_tests(Constraints) [getEnvironmentVariable testConstraints]
if {[info exists test_flags(-constraints)]} then {
eval lappend eagle_tests(Constraints) $test_flags(-constraints)
}
unset -nocomplain test_verbose
set test_verbose [getEnvironmentVariable testVerbose]
if {[string length $test_verbose] == 0} then {
set test_verbose Default
}
if {[info exists test_flags(-verbose)] && \
[string length $test_flags(-verbose)] > 0} then {
#
# NOTE: Map all test verbosity flags we support for script usage
# to their abbreviated names (which are all one letter) and
# then split them into a list.
|
Changes to Externals/Eagle/lib/Test1.0/constraints.eagle.
684
685
686
687
688
689
690
691
692
693
694
695
696
697
...
700
701
702
703
704
705
706
707
708
709
710
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
756
757
758
759
760
761
762
763
764
765
766
|
proc checkForFossil { channel } {
tputs $channel "---- checking for Fossil... "
if {[canExecFossil] && \
[catch {exec -- fossil version} version] == 0} then {
set version [string trim $version]
set pattern {^This is fossil version (.*) \[([0-9a-f]+)\]\
\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2} UTC$}
if {[regexp -- $pattern $version dummy version sourceId]} then {
#
# NOTE: Add a constraint to show that the Fossil executable
# itself is available.
................................................................................
#
# NOTE: Append the version of Fossil currently in use.
#
append result version " " $version " \[" $sourceId \]
if {[canExecFossil] && \
[catch {exec -- fossil remote} remote] == 0} then {
set remote [string trim $remote]; set valid false
if {[isEagle]} then {
#
# NOTE: With Eagle, we can actually validate the URI.
#
if {[uri isvalid $remote]} then {
set valid true
}
} else {
#
# HACK: Currently, there is no simple way to validate
# an arbitrary URI with Tcl (i.e. without using
# some hideously complex regular expression).
#
if {[string length $remote] > 0} then {
set valid true
}
}
if {$valid} then {
#
# NOTE: Add a constraint to show that a valid Fossil
# repository URI appears to be available.
#
addConstraint fossil_repository
#
# NOTE: If we are not prevented from doing so, save the
# test repository to the repository URI currently
# in use to a suitably named global variable.
#
if {![info exists ::no(setRepository)]} then {
set ::test_repository $remote
}
#
# NOTE: Append the repository URI currently in use.
#
append result ", repository \"" $remote \"
#
# NOTE: Show the result of the checking.
#
tputs $channel [appendArgs "yes (" $result ")\n"]
#
# NOTE: We are done here, return now.
#
return
}
}
}
}
tputs $channel no\n
}
proc checkForEagle { channel } {
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
>
|
>
|
|
|
|
|
|
|
<
<
|
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
...
701
702
703
704
705
706
707
708
709
710
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
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
|
proc checkForFossil { channel } {
tputs $channel "---- checking for Fossil... "
if {[canExecFossil] && \
[catch {exec -- fossil version} version] == 0} then {
set version [string trim $version]
set pattern {^This is fossil version (.*) \[([0-9a-f]+)\]\
\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2} UTC$}
if {[regexp -- $pattern $version dummy version sourceId]} then {
#
# NOTE: Add a constraint to show that the Fossil executable
# itself is available.
................................................................................
#
# NOTE: Append the version of Fossil currently in use.
#
append result version " " $version " \[" $sourceId \]
if {[canExecFossil] && \
[catch {exec -- fossil remote-url} remoteUrl] == 0} then {
set remoteUrl [string trim $remoteUrl]; set validUrl false
if {[isEagle]} then {
#
# NOTE: With Eagle, we can actually validate the URL.
#
if {[uri isvalid $remoteUrl]} then {
set validUrl true
}
} else {
#
# HACK: Currently, there is no simple way to validate
# an arbitrary URL with Tcl (i.e. without using
# some hideously complex regular expression).
#
if {[string length $remoteUrl] > 0} then {
set validUrl true
}
}
if {$validUrl} then {
#
# NOTE: Add a constraint to show that a valid Fossil
# repository URL appears to be available.
#
addConstraint fossil_repository_url
#
# NOTE: If we are not prevented from doing so, save
# the test repository URL to the repository
# currently in use to a suitably named global
# variable.
#
if {![info exists ::no(setRepositoryUrl)]} then {
set ::test_repository_url $remoteUrl
}
#
# NOTE: Append the repository URL currently in use.
#
append result ", remote URL \"" $remoteUrl \"
}
}
if {[canExecFossil] && \
[catch {exec -- fossil info} info] == 0} then {
set info [string trim $info]; set validFile false
if {[string length $info] > 0} then {
set pattern {^repository:\s+(.*?)\s+$}
if {[regexp -line -- $pattern $info dummy repository] && \
[file exists $repository]} then {
set validFile true
}
}
if {$validFile} then {
#
# NOTE: Add a constraint to show that a valid Fossil
# repository file appears to be available.
#
addConstraint fossil_repository_file
#
# NOTE: If we are not prevented from doing so, save
# the test repository file for the repository
# currently in use to a suitably named global
# variable.
#
if {![info exists ::no(setRepositoryFile)]} then {
set ::test_repository_file $repository
}
#
# NOTE: Append the repository file currently in use.
#
append result ", local file \"" $repository \"
}
}
#
# NOTE: Show the result of the checking.
#
tputs $channel [appendArgs "yes (" $result ")\n"]
#
# NOTE: We are done here, return now.
#
return
}
}
tputs $channel no\n
}
proc checkForEagle { channel } {
|
Changes to Externals/Eagle/lib/Test1.0/prologue.eagle.
2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 |
checkForWindowsCommandProcessor $test_channel cmd.exe
}
if {![info exists no(fossil)]} then {
checkForFossil $test_channel
}
if {![info exists no(testRepository)]} then {
checkForVariable $test_channel test_repository
}
if {![info exists no(version)]} then {
checkForVersion $test_channel
}
if {![info exists no(eagle)]} then {
|
| | > > > > |
2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 |
checkForWindowsCommandProcessor $test_channel cmd.exe
}
if {![info exists no(fossil)]} then {
checkForFossil $test_channel
}
if {![info exists no(testRepositoryUrl)]} then {
checkForVariable $test_channel test_repository_url
}
if {![info exists no(testRepositoryFile)]} then {
checkForVariable $test_channel test_repository_file
}
if {![info exists no(version)]} then {
checkForVersion $test_channel
}
if {![info exists no(eagle)]} then {
|