System.Data.SQLite
Check-in [85b231175b]
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: 85b231175b9418a9f8d1f01f44a64835b2d49133
User & Date: mistachkin 2015-04-08 21:36:55
Context
2015-04-08
22:03
Modify test suite initialization to work without the 'object' command, if necessary. check-in: 179f0629be user: mistachkin tags: trunk
21:36
Update Eagle script library in externals to the latest trunk code. check-in: 85b231175b user: mistachkin tags: trunk
18:30
Update the included core library documentation. check-in: ba3097cbdb user: mistachkin tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

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

136
137
138
139
140
141
142
143
144
145
146
147











148
149
150
151
152
153



















154

155
156
157
158
159
160
161
...
783
784
785
786
787
788
789

790





791
792
793
794
795
796
797
...
806
807
808
809
810
811
812




813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828






829
830
831
832
833
834
835
...
911
912
913
914
915
916
917




























918
919
920
921
922
923
924
....
1009
1010
1011
1012
1013
1014
1015

1016

1017
1018
1019
1020
1021
1022
1023
....
1041
1042
1043
1044
1045
1046
1047
1048
1049

1050

1051
1052
1053
1054
1055
1056
1057
....
1085
1086
1087
1088
1089
1090
1091



1092
1093
1094
1095
1096
1097
1098
....
1583
1584
1585
1586
1587
1588
1589





1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600

1601
1602
1603
1604
1605
1606
1607
....
1858
1859
1860
1861
1862
1863
1864




1865
1866
1867
1868
1869
1870
1871
1872
....
1894
1895
1896
1897
1898
1899
1900




1901
1902
1903
1904
1905
1906
1907
....
1915
1916
1917
1918
1919
1920
1921

1922
1923
1924
1925
1926
1927
1928
....
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979



1980
1981
1982
1983
1984
1985
1986
....
2011
2012
2013
2014
2015
2016
2017
2018
2019



2020
2021

2022
2023
2024
2025
2026
2027
2028
  proc getEnvironmentVariable { name } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    return [expr {[info exists ::env($name)] ? $::env($name) : ""}]
  }
 
  proc combineFlags { flags1 flags2 } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set result [list]












    foreach flags [list $flags1 $flags2] {
      foreach flag [split $flags ", "] {
        set flag [string trim $flag]

        if {[string length $flag] > 0} then {



















          lappend result $flag

        }
      }
    }

    return [join $result ,]
  }
 
................................................................................
          $::eagle_platform(administrator)}]
    }
 
    proc hasRuntimeOption { name } {
      #
      # NOTE: Returns non-zero if the specified runtime option is set.
      #

      return [object invoke Interpreter.GetActive HasRuntimeOption $name]





    }
 
    proc getPluginFlags { pattern } {
      foreach loaded [info loaded] {
        set plugin [lindex $loaded end]

        if {[regexp -- $pattern $plugin]} then {
................................................................................
    proc getProcesses { name } {
      #
      # NOTE: Start with an empty list of process Ids.
      #
      set result [list]

      #




      # NOTE: Does the caller want processes matching a specific name
      #       or all processes on the local machine?
      #
      if {[string length $name] > 0} then {
        #
        # NOTE: Get the managed array of processes with matching names.
        #
        set array [object invoke -alias System.Diagnostics.Process \
            GetProcessesByName $name]
      } else {
        #
        # NOTE: Get the managed array of all processes on the local
        #       machine.
        #
        set array [object invoke -alias System.Diagnostics.Process \
            GetProcesses]






      }

      #
      # NOTE: For each process in the resulting array, grab the Id.
      #
      for {set index 0} {$index < [$array Length]} {incr index} {
        #
................................................................................
    }
 
    #
    # NOTE: This proc can be used to dynamically compile C# code in a script.
    #
    proc compileCSharp {
            string memory symbols strict resultsVarName errorsVarName args } {




























      #
      # NOTE: Create the C# code provider object (i.e. the compiler).
      #
      set provider [object create -alias Microsoft.CSharp.CSharpCodeProvider]

      #
      # NOTE: Create the object that provides various parameters to the C#
................................................................................
      }

      #
      # NOTE: Prepare to transfer the object reference to the caller.  We
      #       must use upvar here because otherwise the object is lost when
      #       the procedure call frame is cleaned up.
      #

      upvar 1 $resultsVarName results


      #
      # NOTE: Attempt to compile the specified string as C# and capture the
      #       results into the variable provided by the caller.
      #
      set results [$provider -alias CompileAssemblyFromSource $parameters \
          $string]
................................................................................
      if {[$errors HasErrors] || ($strict && [$errors HasWarnings])} then {
        #
        # NOTE: Compilation of the assembly failed.
        #
        set code Error

        #
        # NOTE: Prepare to transfer the error messages to the caller.
        #

        upvar 1 $errorsVarName local_errors


        #
        # NOTE: How many compile errors?
        #
        set count [$errors Count]

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

      #
      # NOTE: We no longer need the collection of compiler errors;
      #       therefore, dispose it now.
      #
      unset errors; # dispose




      return $code
    }
 
    proc matchEnginePublicKeyToken { publicKeyToken } {
      return [expr {[string length $publicKeyToken] == 0 || \
          $publicKeyToken eq [info engine PublicKeyToken]}]
    }
................................................................................
                  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 \
                        [appendArgs $text \n\n "Run the updater now?"] \
                        $caption false]} then {
                      #
                      # NOTE: Ok, run the updater now and then exit.
                      #
                      runUpdateAndExit $automatic

                    }
                  }

                  return [list $text [list $baseUri $patchLevel] [list $notes]]
                }

                #
................................................................................
      } else {
        return [list \
            "could not determine if running build is the latest build"]
      }
    }
 
    proc getReturnType { object member } {




      if {[string length $object] == 0 || [string length $member] == 0} then {
        return ""
      }

      set code [catch {
        object foreach -alias memberInfo \
            [object invoke -noinvoke $object $member] {
          #
................................................................................
      # NOTE: If no error was raised above, return the result; otherwise,
      #       return an empty string to indicate a general failure.
      #
      return [expr {$code == 2 ? $result : ""}]
    }
 
    proc getDefaultValue { typeName } {




      if {[string length $typeName] == 0} then {
        return ""
      }

      set type [object invoke -create -alias Type GetType $typeName]

      if {[string length $type] == 0} then {
................................................................................
      #
      # NOTE: Attempt to query the size from the host; failing that,
      #       return a reasonable default value.
      #
      if {[catch {host size} result] == 0} then {
        return $result
      }

      return [list 80 25]; # TODO: Good default?
    }
 
    proc parray { a args } {
      if {[llength $args] > 2} then {
        error "wrong # args: should be \"parray a ?pattern?\""
      }
................................................................................
        # HACK: Mono does not currently support calling the String.Format
        #       overload that takes a variable number of arguments via
        #       reflection (Mono bug #636939).
        #
        if {![isMono]} then {
          set line [string format -verbatim -- [appendArgs "\{0,-" \
              $maxLength "\} = {1}"] $nameString $valueString]
        } else {
          set line [object invoke String Format [appendArgs "\{0,-" \
              $maxLength "\} = {1}"] $nameString $valueString]



        }

        puts stdout $line
      }
    }
 
    proc pdict { d } {
................................................................................

        #
        # HACK: Mono does not currently support calling the String.Format
        #       overload that takes a variable number of arguments via
        #       reflection (Mono bug #636939).
        #
        if {![isMono]} then {
          set line [string format -verbatim -- "{0,-$maxLength} = {1}" \
              $name $valueString]



        } else {
          set line [object invoke String Format "{0,-$maxLength} = {1}" \

              $name $valueString]
        }

        puts stdout $line
      }
    }
 







|




>
>
>
>
>
>
>
>
>
>
>






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







 







>
|
>
>
>
>
>







 







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







 







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







 







>
|
>







 







|

>
|
>







 







>
>
>







 







>
>
>
>
>
|
|

|
|
|
|
|
|
|
|
>







 







>
>
>
>
|







 







>
>
>
>







 







>







 







|


>
>
>







 







|
|
>
>
>

<
>







136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
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
...
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
...
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
...
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
....
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
....
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
....
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
....
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
....
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
....
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
....
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
....
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
....
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123

2124
2125
2126
2127
2128
2129
2130
2131
  proc getEnvironmentVariable { name } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    return [expr {[info exists ::env($name)] ? $::env($name) : ""}]
  }
 
  proc combineFlags { flags1 flags2 {flags3 ""} {noCase false} } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set result [list]
    set notFlags [list]

    if {[string length $flags3] > 0} then {
      foreach flag [split $flags3 ", "] {
        set flag [string trim $flag]

        if {[string length $flag] > 0} then {
          lappend notFlags $flag
        }
      }
    }

    foreach flags [list $flags1 $flags2] {
      foreach flag [split $flags ", "] {
        set flag [string trim $flag]

        if {[string length $flag] > 0} then {
          set addFlag false

          if {[llength $notFlags] > 0} then {
            set command [list lsearch -exact]

            if {$noCase} then {
              lappend command -nocase
            }

            lappend command -- $notFlags $flag

            if {[eval $command] == -1} then {
              set addFlag true
            }
          } else {
            set addFlag true
          }

          if {$addFlag} then {
            lappend result $flag
          }
        }
      }
    }

    return [join $result ,]
  }
 
................................................................................
          $::eagle_platform(administrator)}]
    }
 
    proc hasRuntimeOption { name } {
      #
      # NOTE: Returns non-zero if the specified runtime option is set.
      #
      if {[catch {
        object invoke Interpreter.GetActive HasRuntimeOption $name
      } result] == 0} then {
        return $result
      } else {
        return false
      }
    }
 
    proc getPluginFlags { pattern } {
      foreach loaded [info loaded] {
        set plugin [lindex $loaded end]

        if {[regexp -- $pattern $plugin]} then {
................................................................................
    proc getProcesses { name } {
      #
      # NOTE: Start with an empty list of process Ids.
      #
      set result [list]

      #
      # NOTE: Are we able to actually query the active processes?
      #
      if {[llength [info commands object]] > 0} then {
        #
        # NOTE: Does the caller want processes matching a specific name
        #       or all processes on the local machine?
        #
        if {[string length $name] > 0} then {
          #
          # NOTE: Get the managed array of processes with matching names.
          #
          set array [object invoke -alias System.Diagnostics.Process \
              GetProcessesByName $name]
        } else {
          #
          # NOTE: Get the managed array of all processes on the local
          #       machine.
          #
          set array [object invoke -alias System.Diagnostics.Process \
              GetProcesses]
        }
      } else {
        #
        # NOTE: No, return nothing.
        #
        return $result
      }

      #
      # NOTE: For each process in the resulting array, grab the Id.
      #
      for {set index 0} {$index < [$array Length]} {incr index} {
        #
................................................................................
    }
 
    #
    # NOTE: This proc can be used to dynamically compile C# code in a script.
    #
    proc compileCSharp {
            string memory symbols strict resultsVarName errorsVarName args } {
      #
      # NOTE: The [object] command is required by this procedure.  If it
      #       is not available, bail out now.
      #
      if {[llength [info commands object]] == 0} then {
        #
        # NOTE: We cannot even attempt to compile anything, fail.
        #
        set code Error

        #
        # NOTE: Prepare to transfer error messages to the caller.
        #
        if {[string length $errorsVarName] > 0} then {
          upvar 1 $errorsVarName local_errors
        }

        #
        # NOTE: Append to the list of errors.
        #
        lappend local_errors "cannot compile, missing \"object\" command"

        #
        # NOTE: Return the overall result to the caller.
        #
        return $code
      }

      #
      # NOTE: Create the C# code provider object (i.e. the compiler).
      #
      set provider [object create -alias Microsoft.CSharp.CSharpCodeProvider]

      #
      # NOTE: Create the object that provides various parameters to the C#
................................................................................
      }

      #
      # NOTE: Prepare to transfer the object reference to the caller.  We
      #       must use upvar here because otherwise the object is lost when
      #       the procedure call frame is cleaned up.
      #
      if {[string length $resultsVarName] > 0} then {
        upvar 1 $resultsVarName results
      }

      #
      # NOTE: Attempt to compile the specified string as C# and capture the
      #       results into the variable provided by the caller.
      #
      set results [$provider -alias CompileAssemblyFromSource $parameters \
          $string]
................................................................................
      if {[$errors HasErrors] || ($strict && [$errors HasWarnings])} then {
        #
        # NOTE: Compilation of the assembly failed.
        #
        set code Error

        #
        # NOTE: Prepare to transfer error messages to the caller.
        #
        if {[string length $errorsVarName] > 0} then {
          upvar 1 $errorsVarName local_errors
        }

        #
        # NOTE: How many compile errors?
        #
        set count [$errors Count]

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

      #
      # NOTE: We no longer need the collection of compiler errors;
      #       therefore, dispose it now.
      #
      unset errors; # dispose

      #
      # NOTE: Return the overall result to the caller.
      #
      return $code
    }
 
    proc matchEnginePublicKeyToken { publicKeyToken } {
      return [expr {[string length $publicKeyToken] == 0 || \
          $publicKeyToken eq [info engine PublicKeyToken]}]
    }
................................................................................
                  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 {
                    #
                    # NOTE: Is the [object] command available?  If not,
                    #       this cannot be done.
                    #
                    if {[llength [info commands object]] > 0} then {
                      set caption [appendArgs \
                          [info engine Name] " " [lindex [info level 0] 0]]

                      if {[object invoke -flags +NonPublic \
                          Eagle._Components.Private.WindowOps YesOrNo \
                          [appendArgs $text \n\n "Run the updater now?"] \
                          $caption false]} then {
                        #
                        # NOTE: Ok, run the updater now and then exit.
                        #
                        runUpdateAndExit $automatic
                      }
                    }
                  }

                  return [list $text [list $baseUri $patchLevel] [list $notes]]
                }

                #
................................................................................
      } else {
        return [list \
            "could not determine if running build is the latest build"]
      }
    }
 
    proc getReturnType { object member } {
      if {[string length $object] == 0} then {
        return ""
      }

      if {[string length $member] == 0} then {
        return ""
      }

      set code [catch {
        object foreach -alias memberInfo \
            [object invoke -noinvoke $object $member] {
          #
................................................................................
      # NOTE: If no error was raised above, return the result; otherwise,
      #       return an empty string to indicate a general failure.
      #
      return [expr {$code == 2 ? $result : ""}]
    }
 
    proc getDefaultValue { typeName } {
      if {[llength [info commands object]] == 0} then {
        return ""
      }

      if {[string length $typeName] == 0} then {
        return ""
      }

      set type [object invoke -create -alias Type GetType $typeName]

      if {[string length $type] == 0} then {
................................................................................
      #
      # NOTE: Attempt to query the size from the host; failing that,
      #       return a reasonable default value.
      #
      if {[catch {host size} result] == 0} then {
        return $result
      }

      return [list 80 25]; # TODO: Good default?
    }
 
    proc parray { a args } {
      if {[llength $args] > 2} then {
        error "wrong # args: should be \"parray a ?pattern?\""
      }
................................................................................
        # HACK: Mono does not currently support calling the String.Format
        #       overload that takes a variable number of arguments via
        #       reflection (Mono bug #636939).
        #
        if {![isMono]} then {
          set line [string format -verbatim -- [appendArgs "\{0,-" \
              $maxLength "\} = {1}"] $nameString $valueString]
        } elseif {[llength [info commands object]] > 0} then {
          set line [object invoke String Format [appendArgs "\{0,-" \
              $maxLength "\} = {1}"] $nameString $valueString]
        } else {
          set line [format [appendArgs "%-" $maxLength "s = %s"] \
              $nameString $valueString]
        }

        puts stdout $line
      }
    }
 
    proc pdict { d } {
................................................................................

        #
        # HACK: Mono does not currently support calling the String.Format
        #       overload that takes a variable number of arguments via
        #       reflection (Mono bug #636939).
        #
        if {![isMono]} then {
          set line [string format -verbatim -- [appendArgs "\{0,-" \
              $maxLength "\} = {1}"] $name $valueString]
        } elseif {[llength [info commands object]] > 0} then {
          set line [object invoke String Format [appendArgs "\{0,-" \
              $maxLength "\} = {1}"] $name $valueString]
        } else {

          set line [format [appendArgs "%-" $maxLength "s = %s"] \
              $name $valueString]
        }

        puts stdout $line
      }
    }
 

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

421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
....
1413
1414
1415
1416
1417
1418
1419


1420
1421
1422
1423
1424
1425
1426
....
1427
1428
1429
1430
1431
1432
1433


1434
1435
1436
1437
1438
1439
1440


1441















1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456

1457
1458
1459
1460
1461
1462
1463
....
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
      return [clock format $seconds -gmt $gmt -iso -isotimezone]
    } else {
      return [clock format $seconds -gmt $gmt -format "%Y-%m-%dT%H:%M:%S %Z"]
    }
  }
 
  proc formatElapsedTime { seconds } {
    if {[isEagle]} then {
      #
      # NOTE: Create a TimeSpan instance based on the number of whole
      #       seconds.
      #
      set timeSpan [object invoke -create -alias TimeSpan FromSeconds \
          $seconds]

................................................................................
 
  proc recordTestStatistics { varName index } {
    #
    # NOTE: Record counts of all object types that we track.
    #
    upvar 1 $varName array



    set array(uncounted,$index) [list]
    set array(time,$index) [clock seconds]
    set array(afters,$index) [llength [after info]]
    set array(variables,$index) [llength [info globals]]
    set array(commands,$index) [llength [info commands]]
    set array(procedures,$index) [llength [info procs]]
    set array(namespaces,$index) [llength [namespace children ::]]
................................................................................
    set array(files,$index) [llength [getFiles $::test_path *]]
    set array(temporaryFiles,$index) [llength [getFiles [getTemporaryPath] *]]
    set array(channels,$index) [llength [file channels]]
    set array(aliases,$index) [llength [interp aliases]]
    set array(interpreters,$index) [llength [interp slaves]]
    set array(environment,$index) [llength [array names env]]



    #
    # NOTE: These native resource types cannot be positively checked
    #       for leaks (i.e. because the "leak" may be from an external
    #       process).
    #
    lappend array(uncounted,$index) temporaryFiles



    if {[isEagle]} then {















      set array(scopes,$index) [llength [scope list]]
      set array(assemblies,$index) [llength [object assemblies]]
      set array(processes,$index) [llength [getProcesses ""]]
      set array(objects,$index) [llength [info objects]]
      set array(objectCallbacks,$index) [llength [info callbacks]]
      set array(objectTypes,$index) [llength [object types]]
      set array(objectInterfaces,$index) [llength [object interfaces]]
      set array(objectNamespaces,$index) [llength [object namespaces]]

      #
      # NOTE: These managed resource types cannot be positively checked
      #       for leaks (i.e. because the "leak" may be from an external
      #       process).
      #
      lappend array(uncounted,$index) assemblies processes


      #
      # NOTE: Support for some of all of these entity types may not be
      #       present in the interpreter, initialize all these counts
      #       to zero and then try to query each one individually below
      #       wrapped in a catch.
      #
................................................................................

      catch {set array(connections,$index) [llength [info connections]]}
      catch {set array(transactions,$index) [llength [info transactions]]}
      catch {set array(modules,$index) [llength [info modules]]}
      catch {set array(delegates,$index) [llength [info delegates]]}

      if {[llength [info commands tcl]] > 0} then {
        set array(tcl,$index) [tcl ready]
      }

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

      #
      # NOTE: Grab the number of active threads that are active because
      #       of ScriptThread object instances.  This only works if Eagle
      #       is Beta 31 or higher.
      #
      catch {
        set array(scriptThreads,$index) [object invoke -flags +NonPublic \
            ScriptThread activeCount]
      }









    }
  }
 
  proc reportTestStatistics { channel fileName statsVarName filesVarName } {
    set statistics [list afters variables commands procedures namespaces \
        files temporaryFiles channels aliases interpreters environment]








|







 







>
>







 







>
>







>
>

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

<
<
<
<
<
<
>







 







|












|
|

>
>
>
>
>
>
>
>
>







421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
....
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
....
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471






1472
1473
1474
1475
1476
1477
1478
1479
....
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
      return [clock format $seconds -gmt $gmt -iso -isotimezone]
    } else {
      return [clock format $seconds -gmt $gmt -format "%Y-%m-%dT%H:%M:%S %Z"]
    }
  }
 
  proc formatElapsedTime { seconds } {
    if {[isEagle] && [llength [info commands object]] > 0} then {
      #
      # NOTE: Create a TimeSpan instance based on the number of whole
      #       seconds.
      #
      set timeSpan [object invoke -create -alias TimeSpan FromSeconds \
          $seconds]

................................................................................
 
  proc recordTestStatistics { varName index } {
    #
    # NOTE: Record counts of all object types that we track.
    #
    upvar 1 $varName array

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

    set array(uncounted,$index) [list]
    set array(time,$index) [clock seconds]
    set array(afters,$index) [llength [after info]]
    set array(variables,$index) [llength [info globals]]
    set array(commands,$index) [llength [info commands]]
    set array(procedures,$index) [llength [info procs]]
    set array(namespaces,$index) [llength [namespace children ::]]
................................................................................
    set array(files,$index) [llength [getFiles $::test_path *]]
    set array(temporaryFiles,$index) [llength [getFiles [getTemporaryPath] *]]
    set array(channels,$index) [llength [file channels]]
    set array(aliases,$index) [llength [interp aliases]]
    set array(interpreters,$index) [llength [interp slaves]]
    set array(environment,$index) [llength [array names env]]

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

    #
    # NOTE: These native resource types cannot be positively checked
    #       for leaks (i.e. because the "leak" may be from an external
    #       process).
    #
    lappend array(uncounted,$index) temporaryFiles

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

    if {[isEagle]} then {
      #
      # NOTE: Support for some of all of these entity types may not be
      #       present in the interpreter, initialize all these counts
      #       to zero and then try to query each one individually below
      #       wrapped in a catch.
      #
      set array(scopes,$index) 0
      set array(assemblies,$index) 0
      set array(processes,$index) 0
      set array(objects,$index) 0
      set array(objectCallbacks,$index) 0
      set array(objectTypes,$index) 0
      set array(objectInterfaces,$index) 0
      set array(objectNamespaces,$index) 0

      catch {set array(scopes,$index) [llength [scope list]]}
      catch {set array(assemblies,$index) [llength [object assemblies]]}
      catch {set array(processes,$index) [llength [getProcesses ""]]}
      catch {set array(objects,$index) [llength [info objects]]}
      catch {set array(objectCallbacks,$index) [llength [info callbacks]]}
      catch {set array(objectTypes,$index) [llength [object types]]}
      catch {set array(objectInterfaces,$index) [llength [object interfaces]]}
      catch {set array(objectNamespaces,$index) [llength [object namespaces]]}







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

      #
      # NOTE: Support for some of all of these entity types may not be
      #       present in the interpreter, initialize all these counts
      #       to zero and then try to query each one individually below
      #       wrapped in a catch.
      #
................................................................................

      catch {set array(connections,$index) [llength [info connections]]}
      catch {set array(transactions,$index) [llength [info transactions]]}
      catch {set array(modules,$index) [llength [info modules]]}
      catch {set array(delegates,$index) [llength [info delegates]]}

      if {[llength [info commands tcl]] > 0} then {
        catch {set array(tcl,$index) [tcl ready]}
      }

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

      #
      # NOTE: Grab the number of active threads that are active because
      #       of ScriptThread object instances.  This only works if Eagle
      #       is Beta 31 or higher.
      #
      catch {
        set array(scriptThreads,$index) \
            [object invoke -flags +NonPublic ScriptThread activeCount]
      }

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

      #
      # NOTE: These managed resource types cannot be positively checked
      #       for leaks (i.e. because the "leak" may be from an external
      #       process).
      #
      lappend array(uncounted,$index) assemblies processes
    }
  }
 
  proc reportTestStatistics { channel fileName statsVarName filesVarName } {
    set statistics [list afters variables commands procedures namespaces \
        files temporaryFiles channels aliases interpreters environment]

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

26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

44
45
46
47
48
49
50
51
52
53
54
....
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025

1026
1027
1028
1029
1030
1031
1032


1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
....
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
....
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
....
2823
2824
2825
2826
2827
2828
2829































2830
2831
2832
2833
2834
2835
2836
....
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
....
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
        ASSEMBLY_STRONG_NAME_TAG ASSEMBLY_TAG ASSEMBLY_TEXT ASSEMBLY_URI \
        BREAK_ON_EXITING BREAKPOINTS CACHE_ARGUMENT_TOSTRING \
        CACHE_ARGUMENTLIST_TOSTRING CACHE_DICTIONARY CACHE_RESULT_TOSTRING \
        CACHE_STATISTICS CACHE_STRINGLIST_TOSTRING CALLBACK_QUEUE CAS_POLICY \
        CODE_ANALYSIS COM_TYPE_CACHE CONSOLE DAEMON DATA DEAD_CODE DEBUG \
        DEBUGGER DEBUGGER_ARGUMENTS DEBUGGER_ENGINE DEBUGGER_EXECUTE \
        DEBUGGER_EXPRESSION DEBUGGER_VARIABLE DEBUG_TRACE DEBUG_WRITE DRAWING \
        DYNAMIC EAGLE EMBEDDED_LIBRARY EXECUTE_CACHE EXPRESSION_FLAGS \
        FAST_ERRORCODE FAST_ERRORINFO HAVE_SIZEOF HISTORY IA64 \
        INTERACTIVE_COMMANDS INTERNALS_VISIBLE_TO ISOLATED_INTERPRETERS \
        ISOLATED_PLUGINS LIBRARY LICENSING LIST_CACHE MONO MONO_BUILD \
        MONO_HACKS MONO_LEGACY NATIVE NATIVE_PACKAGE NATIVE_UTILITY \
        NATIVE_UTILITY_BSTR NETWORK NET_20 NET_20_FAST_ENUM NET_20_ONLY \
        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.
    #
................................................................................
  }
 
  proc checkForNamespaces { channel quiet } {
    tputs $channel "---- checking for namespace support... "

    if {[isEagle]} then {
      #
      # NOTE: Check if namespace support was compiled into the core library
      #       (i.e. this is beta 30 or later).
      #

      set available false

      if {[catch {string length [object invoke \
              Type GetType Eagle._Commands.Namespace2]} length] == 0 && \
          [set available [expr {$length > 0}]]} then {
        addConstraint namespaces.available
      } else {


        addConstraint namespaces.unavailable
      }

      if {[catch {object invoke -flags +NonPublic Interpreter.GetActive \
              AreNamespacesEnabled} enabled] == 0} then {
        #
        # NOTE: We were able to query for namespace support (i.e. this
        #       must be beta 29 or later); however, we still need to
        #       check if it has been enabled at runtime.
        #
        if {$enabled} then {
          #
          # NOTE: Yes, it appears that it is available and enabled.
          #
          addConstraint namespaces

          tputs $channel enabled\n
        } else {
          tputs $channel disabled\n

          #
          # NOTE: Check if namespace support was compiled into the core
          #       library (i.e. is this beta 30 or later).
          #
          if {!$quiet && $available} then {
            #
            # NOTE: The tests seem to be running with namespace support
            #       available, but disabled.  Emit a warning into the
            #       test log file.
            #
            tputs $channel \
                "==== WARNING: running with namespaces available and disabled\n"
          }
        }
      } else {
        tputs $channel error\n
      }
    } else {
      #
      # NOTE: All supported versions of native Tcl have namespaces enabled
      #       and available.
      #
      addConstraint namespaces.available
................................................................................
        tputs $channel error\n
      }
    }
 
    proc checkForPrimaryThread { channel } {
      tputs $channel "---- checking for primary thread... "

      if {[catch {object invoke Interpreter.GetActive ThreadId} \
              threadId] == 0 && \
          [info tid] == $threadId} then {
        addConstraint primaryThread

        tputs $channel [appendArgs "yes (" $threadId ")\n"]
      } else {
        tputs $channel [appendArgs "no (" $threadId ")\n"]
      }
    }
................................................................................
      }
    }
 
    proc checkForObjectMember { channel object member {constraint ""} } {
      tputs $channel [appendArgs "---- checking for object member \"" \
          $object . $member "\"... "]

      if {[catch {object members -flags +NonPublic -pattern $member $object} \
              members] == 0 && \
          [llength $members] > 0} then {
        #
        # NOTE: Yes, it appears that it is available.
        #
        if {[string length $constraint] > 0} then {
          addConstraint [appendArgs member_ $constraint]
        } else {
          addConstraint [appendArgs $object. [string trim $member *?]]
................................................................................
        } elseif {[haveConstraint tclLibrary84]} then {
          addConstraint tclReadyOrLibrary84
        }

        tputs $channel no\n
      }
    }































 
    proc checkForTclShell { channel } {
      #
      # HACK: If this returns "error" that normally indicates an error was
      #       caught during [exec] (i.e. the native Tcl shell could not be
      #       executed).
      #
................................................................................
      #
      if {[catch {object invoke -flags +NonPublic Interpreter.GetActive \
              Debugger} debugger] == 0} then {
        #
        # NOTE: We do not own this, do not dispose it.
        #
        if {[string length $debugger] > 0} then {
          object flags $debugger +NoDispose
        }

        if {[regexp -- {^Debugger#\d+$} $debugger]} then {
          #
          # NOTE: Yes, it appears that it is available.
          #
          addConstraint scriptDebugger
................................................................................
      #
      if {[catch {object invoke -flags +NonPublic Interpreter.GetActive \
              Debugger} debugger] == 0} then {
        #
        # NOTE: We do not own this, do not dispose it.
        #
        if {[string length $debugger] > 0} then {
          object flags $debugger +NoDispose
        }

        if {[regexp -- {^Debugger#\d+$} $debugger] && \
            [catch {object invoke $debugger Interpreter} interp] == 0} then {
          #
          # NOTE: We do not own this, do not dispose it.
          #
          if {[string length $interp] > 0} then {
            object flags $interp +NoDispose
          }

          if {[regexp -- {^Interpreter#\d+$} $interp]} then {
            #
            # NOTE: Yes, it appears that it is available.
            #
            addConstraint scriptDebuggerInterpreter







|
|
|

|
|
|
|

|
|
>
|
|
|
|







 







|
|

>
|

<
<
<


>
>



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

|
|
|

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







 







|
<
<







 







|
|
|







 







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







 







|







 







|








|







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
....
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029



1030
1031
1032
1033
1034
1035
1036


1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064



1065
1066
1067
1068
1069
1070
1071
....
2047
2048
2049
2050
2051
2052
2053
2054


2055
2056
2057
2058
2059
2060
2061
....
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
....
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
....
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
....
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
        ASSEMBLY_STRONG_NAME_TAG ASSEMBLY_TAG ASSEMBLY_TEXT ASSEMBLY_URI \
        BREAK_ON_EXITING BREAKPOINTS CACHE_ARGUMENT_TOSTRING \
        CACHE_ARGUMENTLIST_TOSTRING CACHE_DICTIONARY CACHE_RESULT_TOSTRING \
        CACHE_STATISTICS CACHE_STRINGLIST_TOSTRING CALLBACK_QUEUE CAS_POLICY \
        CODE_ANALYSIS COM_TYPE_CACHE CONSOLE DAEMON DATA DEAD_CODE DEBUG \
        DEBUGGER DEBUGGER_ARGUMENTS DEBUGGER_ENGINE DEBUGGER_EXECUTE \
        DEBUGGER_EXPRESSION DEBUGGER_VARIABLE DEBUG_TRACE DEBUG_WRITE DRAWING \
        DYNAMIC EAGLE EMBEDDED_LIBRARY EMBED_CERTIFICATE EXECUTE_CACHE \
        EXPRESSION_FLAGS FAST_ERRORCODE FAST_ERRORINFO HAVE_SIZEOF HISTORY \
        IA64 INTERACTIVE_COMMANDS INTERNALS_VISIBLE_TO ISOLATED_INTERPRETERS \
        ISOLATED_PLUGINS LIBRARY LICENSING LIST_CACHE MONO MONO_BUILD \
        MONO_HACKS MONO_LEGACY NATIVE NATIVE_PACKAGE NATIVE_THREAD_ID \
        NATIVE_UTILITY NATIVE_UTILITY_BSTR NETWORK NET_20 NET_20_FAST_ENUM \
        NET_20_ONLY 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 OBFUSCATION OFFICIAL PARSE_CACHE PATCHLEVEL \
        PLUGIN_COMMANDS POLICY_TRACE PREVIOUS_RESULT RANDOMIZE_ID REMOTING \
        SAMPLE SECURITY 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.
    #
................................................................................
  }
 
  proc checkForNamespaces { channel quiet } {
    tputs $channel "---- checking for namespace support... "

    if {[isEagle]} then {
      #
      # NOTE: Check if namespace support was compiled into the core
      #       library (i.e. this is beta 30 or later).
      #
      if {[catch {namespace enable} enabled] == 0} then {
        set available true




        addConstraint namespaces.available
      } else {
        set available false

        addConstraint namespaces.unavailable
      }



      #
      # NOTE: We were able to query for namespace support (i.e. this
      #       must be beta 29 or later); however, we still need to
      #       check if it has been enabled at runtime.
      #
      if {$enabled} then {
        #
        # NOTE: Yes, it appears that it is available and enabled.
        #
        addConstraint namespaces

        tputs $channel enabled\n
      } else {
        tputs $channel disabled\n

        #
        # NOTE: Check if namespace support was compiled into the core
        #       library (i.e. is this beta 30 or later).
        #
        if {!$quiet && $available} then {
          #
          # NOTE: The tests seem to be running with namespace support
          #       available, but disabled.  Emit a warning into the
          #       test log file.
          #
          tputs $channel \
              "==== WARNING: running with namespaces available and disabled\n"
        }



      }
    } else {
      #
      # NOTE: All supported versions of native Tcl have namespaces enabled
      #       and available.
      #
      addConstraint namespaces.available
................................................................................
        tputs $channel error\n
      }
    }
 
    proc checkForPrimaryThread { channel } {
      tputs $channel "---- checking for primary thread... "

      if {[info tid] == [set threadId [info ptid]]} then {


        addConstraint primaryThread

        tputs $channel [appendArgs "yes (" $threadId ")\n"]
      } else {
        tputs $channel [appendArgs "no (" $threadId ")\n"]
      }
    }
................................................................................
      }
    }
 
    proc checkForObjectMember { channel object member {constraint ""} } {
      tputs $channel [appendArgs "---- checking for object member \"" \
          $object . $member "\"... "]

      if {[catch {
        object members -flags +NonPublic -pattern $member $object
      } members] == 0 && [llength $members] > 0} then {
        #
        # NOTE: Yes, it appears that it is available.
        #
        if {[string length $constraint] > 0} then {
          addConstraint [appendArgs member_ $constraint]
        } else {
          addConstraint [appendArgs $object. [string trim $member *?]]
................................................................................
        } elseif {[haveConstraint tclLibrary84]} then {
          addConstraint tclReadyOrLibrary84
        }

        tputs $channel no\n
      }
    }
 
    proc checkForTclSelect { channel } {
      tputs $channel "---- checking for Tcl library selection... "

      if {[catch {tcl select -architecture} select] == 0} then {
        #
        # NOTE: Yes, native Tcl is "probably loadable".
        #
        addConstraint tclSelect

        #
        # NOTE: Ok, attempt to determine the selected Tcl version.
        #
        if {[catch {
          getDictionaryValue $select version
        } version] == 0 && [regexp -- {^\d+\.\d+$} $version]} then {
          addConstraint [appendArgs \
              tclSelect [string map [list . ""] $version]]

          tputs $channel [appendArgs "yes (" $select ")\n"]
        } else {
          #
          # NOTE: The Tcl library is "probably loadable"; however, we have
          #       no idea what version it actually is.
          #
          tputs $channel yes\n
        }
      } else {
        tputs $channel no\n
      }
    }
 
    proc checkForTclShell { channel } {
      #
      # HACK: If this returns "error" that normally indicates an error was
      #       caught during [exec] (i.e. the native Tcl shell could not be
      #       executed).
      #
................................................................................
      #
      if {[catch {object invoke -flags +NonPublic Interpreter.GetActive \
              Debugger} debugger] == 0} then {
        #
        # NOTE: We do not own this, do not dispose it.
        #
        if {[string length $debugger] > 0} then {
          catch {object flags $debugger +NoDispose}
        }

        if {[regexp -- {^Debugger#\d+$} $debugger]} then {
          #
          # NOTE: Yes, it appears that it is available.
          #
          addConstraint scriptDebugger
................................................................................
      #
      if {[catch {object invoke -flags +NonPublic Interpreter.GetActive \
              Debugger} debugger] == 0} then {
        #
        # NOTE: We do not own this, do not dispose it.
        #
        if {[string length $debugger] > 0} then {
          catch {object flags $debugger +NoDispose}
        }

        if {[regexp -- {^Debugger#\d+$} $debugger] && \
            [catch {object invoke $debugger Interpreter} interp] == 0} then {
          #
          # NOTE: We do not own this, do not dispose it.
          #
          if {[string length $interp] > 0} then {
            catch {object flags $interp +NoDispose}
          }

          if {[regexp -- {^Interpreter#\d+$} $interp]} then {
            #
            # NOTE: Yes, it appears that it is available.
            #
            addConstraint scriptDebuggerInterpreter

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

21
22
23
24
25
26
27

28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
...
107
108
109
110
111
112
113
114
115
116





117
118
119
120
121
122
123

  #
  # NOTE: Verify that the current call frame is correct and that the
  #       interpreter call stack has not been imbalanced by previous
  #       tests or other errors.  This check only applies to Eagle.
  #
  if {[isEagle]} then {

    #
    # NOTE: Check the name of the current call frame against the one
    #       that should be used for evaluating this script file.
    #
    if {[object invoke -flags +NonPublic \
            Interpreter.GetActive.CurrentFrame Name] ne \
        [list source [file normalize [info script]]]} then {
      unset -nocomplain test_suite_running
      error "cannot run, current frame is not for this script"

    }
  }

  #
  # NOTE: Make sure all the variables used by this epilogue are unset.
  #
  unset -nocomplain memory stack name count passedOrSkipped percent \
................................................................................
            " microseconds\n"]
      }
    }

    #
    # NOTE: Show the ending operation count (for Eagle only).
    #
    tputs $test_channel [appendArgs "---- ending operation count: " \
        [object invoke -flags +NonPublic Interpreter.GetActive \
            OperationCount] \n]






    #
    # NOTE: Show the current state of the memory.
    #
    catch {debug memory} memory

    tputs $test_channel [appendArgs "---- ending memory: " \







>
|
|
|
|
|
|
|
|
|
>







 







|
|
|
>
>
>
>
>







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
...
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130

  #
  # NOTE: Verify that the current call frame is correct and that the
  #       interpreter call stack has not been imbalanced by previous
  #       tests or other errors.  This check only applies to Eagle.
  #
  if {[isEagle]} then {
    catch {
      #
      # NOTE: Check the name of the current call frame against the one
      #       that should be used for evaluating this script file.
      #
      if {[object invoke -flags +NonPublic \
              Interpreter.GetActive.CurrentFrame Name] ne \
          [list source [file normalize [info script]]]} then {
        unset -nocomplain test_suite_running
        error "cannot run, current frame is not for this script"
      }
    }
  }

  #
  # NOTE: Make sure all the variables used by this epilogue are unset.
  #
  unset -nocomplain memory stack name count passedOrSkipped percent \
................................................................................
            " microseconds\n"]
      }
    }

    #
    # NOTE: Show the ending operation count (for Eagle only).
    #
    catch {
      object invoke -flags +NonPublic Interpreter.GetActive OperationCount
    } operationCount

    tputs $test_channel [appendArgs "---- ending operation count: " \
        $operationCount \n]

    unset operationCount

    #
    # NOTE: Show the current state of the memory.
    #
    catch {debug memory} memory

    tputs $test_channel [appendArgs "---- ending memory: " \

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

216
217
218
219
220
221
222

223
224
225
226
227
228
229
230
231

232
233
234
235
236
237
238
....
1486
1487
1488
1489
1490
1491
1492




1493
1494
1495
1496
1497
1498
1499
....
1506
1507
1508
1509
1510
1511
1512





















1513
1514
1515
1516
1517
1518
1519
....
1915
1916
1917
1918
1919
1920
1921






1922
1923
1924
1925
1926
1927
1928
....
2637
2638
2639
2640
2641
2642
2643




2644
2645
2646
2647
2648
2649
2650
....
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021





3022
3023
3024
3025
3026
3027
3028
  #
  # NOTE: Verify that the current call frame is correct and that the
  #       interpreter call stack has not been imbalanced by previous
  #       tests or other errors.  This check only applies to Eagle.
  #       This block requires the "Eagle.Library" package.
  #
  if {[isEagle]} then {

    #
    # NOTE: Check the name of the current call frame against the one
    #       that should be used for evaluating this script file.
    #
    if {[object invoke -flags +NonPublic \
            Interpreter.GetActive.CurrentFrame Name] ne \
        [list source [file normalize [info script]]]} then {
      unset -nocomplain test_suite_running
      error "cannot run, current frame is not for this script"

    }
  }

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

  #
  # NOTE: Set the local root directory of the source checkout (i.e. of Eagle
................................................................................
        #
        checkForTclInstalls $test_channel
      }

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





      if {![info exists no(tclShell)]} then {
        #
        # NOTE: For test "garuda-1.1".
        #
        checkForTclShell $test_channel
      }
................................................................................
      }
    }

    #
    # 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 \
            *TestNullArray*

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







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

        checkForObjectMember $test_channel Eagle._Tests.Default \
................................................................................
  if {![info exists no(callbackCommand)]} then {
    checkForCommand $test_channel callback
  }

  if {![info exists no(libraryCommand)]} then {
    checkForCommand $test_channel library
  }





  if {![info exists no(socketCommand)]} then {
    checkForCommand $test_channel socket
  }

  if {![info exists no(sqlCommand)]} then {
    checkForCommand $test_channel sql
................................................................................
  tputs $test_channel [appendArgs "---- starting command count: " \
      [info cmdcount] \n]

  if {[isEagle]} then {
    #
    # NOTE: Show the starting operation count (for Eagle only).
    #
    tputs $test_channel [appendArgs "---- starting operation count: " \
        [object invoke -flags +NonPublic Interpreter.GetActive \
            OperationCount] \n]






    #
    # NOTE: Record the raw starting performance count, for later use in
    #       calculating the approximate number of microseconds elapsed.
    #
    catch {set test_timestamp(startCount) [clock start]}
  }







>
|
|
|
|
|
|
|
|
|
>







 







>
>
>
>







 







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







 







>
>
>
>
>
>







 







>
>
>
>







 







|
|
|
>
>
>
>
>







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
....
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
....
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
....
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
....
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
....
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
  #
  # NOTE: Verify that the current call frame is correct and that the
  #       interpreter call stack has not been imbalanced by previous
  #       tests or other errors.  This check only applies to Eagle.
  #       This block requires the "Eagle.Library" package.
  #
  if {[isEagle]} then {
    catch {
      #
      # NOTE: Check the name of the current call frame against the one
      #       that should be used for evaluating this script file.
      #
      if {[object invoke -flags +NonPublic \
              Interpreter.GetActive.CurrentFrame Name] ne \
          [list source [file normalize [info script]]]} then {
        unset -nocomplain test_suite_running
        error "cannot run, current frame is not for this script"
      }
    }
  }

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

  #
  # NOTE: Set the local root directory of the source checkout (i.e. of Eagle
................................................................................
        #
        checkForTclInstalls $test_channel
      }

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

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

      if {![info exists no(tclShell)]} then {
        #
        # NOTE: For test "garuda-1.1".
        #
        checkForTclShell $test_channel
      }
................................................................................
      }
    }

    #
    # NOTE: Has custom test method support been disabled?
    #
    if {![info exists no(core)] && ![info exists no(test)]} then {
      #
      # NOTE: Has optional parameter testing support been disabled?
      #
      if {![info exists no(testOptionalParameter)]} then {
        #
        # NOTE: For tests "object-2.81", "object-2.82", "object-2.83",
        #       and "object-2.84".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestOptionalParameter0*

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

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

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

      #
      # 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 \
            *TestNullArray*

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

        #
        # NOTE: For tests "object-7.6" and "object-7.7".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestByRefArray*

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

        checkForObjectMember $test_channel Eagle._Tests.Default \
................................................................................
  if {![info exists no(callbackCommand)]} then {
    checkForCommand $test_channel callback
  }

  if {![info exists no(libraryCommand)]} then {
    checkForCommand $test_channel library
  }

  if {![info exists no(objectCommand)]} then {
    checkForCommand $test_channel object
  }

  if {![info exists no(socketCommand)]} then {
    checkForCommand $test_channel socket
  }

  if {![info exists no(sqlCommand)]} then {
    checkForCommand $test_channel sql
................................................................................
  tputs $test_channel [appendArgs "---- starting command count: " \
      [info cmdcount] \n]

  if {[isEagle]} then {
    #
    # NOTE: Show the starting operation count (for Eagle only).
    #
    catch {
      object invoke -flags +NonPublic Interpreter.GetActive OperationCount
    } operationCount

    tputs $test_channel [appendArgs "---- starting operation count: " \
        $operationCount \n]

    unset operationCount

    #
    # NOTE: Record the raw starting performance count, for later use in
    #       calculating the approximate number of microseconds elapsed.
    #
    catch {set test_timestamp(startCount) [clock start]}
  }