System.Data.SQLite
Check-in [8130180a1d]
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 | trunk
Files: files | file ages | folders
SHA1: 8130180a1d34d6c96d325b758c433be6789d016c
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
Hide Diffs Unified Diffs Ignore Whitespace Patch

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 {