System.Data.SQLite

Check-in [ecd546a7a7]
Login

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

Overview
Comment:Update Eagle in externals to the pre-beta 34 release code.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ecd546a7a7f0066aaac641272dc63ee9e12ca70e
User & Date: mistachkin 2015-08-15 06:38:07.602
Context
2015-08-15
17:08
Compilation fixes for the debug build. check-in: 8195809af1 user: mistachkin tags: trunk
06:38
Update Eagle in externals to the pre-beta 34 release code. check-in: ecd546a7a7 user: mistachkin tags: trunk
2015-08-14
03:44
Fix help description of the 'Cache Size' connection string property. check-in: 5e16011b0c user: mistachkin tags: trunk
Changes
Unified Diff Show Whitespace Changes 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/bin/EagleShell32.exe.

cannot compute difference between binary files

Changes to Externals/Eagle/bin/x64/Spilornis.dll.

cannot compute difference between binary files

Changes to Externals/Eagle/bin/x86/Spilornis.dll.

cannot compute difference between binary files

Changes to Externals/Eagle/lib/Eagle1.0/init.eagle.
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
      if {[llength $args] > 2} then {
        error "wrong # args: should be \"parray a ?pattern?\""
      }

      upvar 1 $a array

      if {![array exists array]} {
        error "\"$a\" isn't an array"
      }

      set names [lsort [eval array names array $args]]
      set maxLength 0

      foreach name $names {
        set length [string length $name]







|







2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
      if {[llength $args] > 2} then {
        error "wrong # args: should be \"parray a ?pattern?\""
      }

      upvar 1 $a array

      if {![array exists array]} {
        error [appendArgs \" $a "\" isn't an array"]
      }

      set names [lsort [eval array names array $args]]
      set maxLength 0

      foreach name $names {
        set length [string length $name]
2154
2155
2156
2157
2158
2159
2160
2161















































































































2162
2163
2164
2165

2166
2167
2168





















2169




2170
2171
2172
2173
2174
2175
2176
        # NOTE: Old style test, use [test1] command.
        #
        set command test1
      }

      return [uplevel 1 [list $command $name $description] $args]
    }
















































































































    proc unknown { name args } {
      #
      # NOTE: This is a stub unknown procedure that simply produces an
      #       appropriate error message.

      #
      # TODO: Add support for auto-loading packages here in the future?
      #





















      return -code error "invalid command name \"$name\""




    }

    namespace eval ::tcl::tm {
      #
      # NOTE: Ideally, this procedure should be created in the "::tcl::tm"
      #       namespace.
      #








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


|
|
>



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







2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
        # NOTE: Old style test, use [test1] command.
        #
        set command test1
      }

      return [uplevel 1 [list $command $name $description] $args]
    }

    proc isObjectHandle { value } {
      set pattern [string map [list \\ \\\\ \[ \\\[ \] \\\]] $value]
      set objects [info objects $pattern]

      if {[llength $objects] == 1 && [lindex $objects 0] eq $value} then {
        return true
      }

      return false
    }

    proc isManagedType { name } {
      if {[llength [info commands object]] > 0} then {
        if {![isObjectHandle $name]} then {
          if {[catch {
            object members -matchnameonly -nameonly -pattern Equals $name
          } result] == 0 && $result eq "Equals"} then {
            return true
          }
        }
      }

      return false
    }

    proc canGetManagedType { name {varName ""} } {
      if {[llength [info commands object]] > 0} then {
        if {![isObjectHandle $name]} then {
          set cultureInfo [object invoke Interpreter.GetActive CultureInfo]
          set type null

          set code [object invoke -create -alias -flags +NonPublic \
              Value GetType "" $name null null None $cultureInfo type]

          if {[$code ToString] eq "Ok"} then {
            if {[string length $varName] > 0} then {
              upvar 1 $varName typeName
            }

            set typeName [$type AssemblyQualifiedName]

            if {[isManagedType $typeName]} then {
              return true
            }
          }
        }
      }

      return false
    }

    proc unknownObjectInvoke { level name args } {
      #
      # NOTE: This is an [unknown] procedure that attempts to lookup the
      #       name as a CLR type and then attempts to use [object invoke]
      #       with it, merging options and arguments as necessary.
      #
      if {[llength [info commands object]] > 0 && \
          ([isManagedType $name] || [canGetManagedType $name name])} then {
        #
        # NOTE: Get possible options for the [object invoke] sub-command.
        #
        set options [object invoke Utility GetInvokeOptions Invoke]

        #
        # NOTE: Create argument list for the artificial [object invoke]
        #       alias.  This always has two arguments.
        #
        set arguments1 [object create ArgumentList object invoke]

        #
        # NOTE: Create argument list for the entire command being handled.
        #       There may be options right after the command name itself.
        #
        set arguments2 [eval \
            object create ArgumentList [concat [list $name] $args]]

        #
        # NOTE: Setup output arguments needed for the MergeArguments method.
        #
        set arguments3 null; set error null

        #
        # NOTE: Attempt to merge the option and non-option arguments into a
        #       single list of arguments.
        #
        set code [object invoke -alias -flags +NonPublic \
            Interpreter.GetActive MergeArguments $options $arguments1 \
            $arguments2 2 1 false false arguments3 error]

        #
        # NOTE: Was the argument merging process successful?
        #
        if {$code eq "Ok"} then {
          #
          # NOTE: Jump up from our call frame (and optionally that of our
          #       caller) and attempt to invoke the specified static object
          #       method with the final list of merged arguments.
          #
          return [uplevel [expr {$level + 1}] [$arguments3 ToString]]
        } else {
          #
          # NOTE: Failed to merge the arguments, raise an error.
          #
          error [$error ToString]
        }
      }

      continue; # NOTE: Not handled.
    }

    proc unknown { name args } {
      #
      # NOTE: This is an [unknown] procedure that normally produces an
      #       appropriate error message; however, it can optionally try
      #       to invoke a static object method.
      #
      # TODO: Add support for auto-loading packages here in the future?
      #
      if {[hasRuntimeOption unknownObjectInvoke] && \
          [llength [info commands object]] > 0} then {
        #
        # NOTE: In the context of the caller, attempt to invoke a static
        #       object method using the specified arguments (which may
        #       contain variable names).
        #
        if {[catch {
          eval unknownObjectInvoke 1 [list $name] $args
        } result] == 0} then {
          #
          # NOTE: The static object method was invoked successfully.
          #       Return its result.
          #
          return -code ok $result
        } elseif {[string length $result] > 0} then {
          #
          # NOTE: Attempting to invoke the static object method raised
          #       an error.  Re-raise it now.  If no error message was
          #       provided, fallback on the default (below).
          #
          return -code error $result
        }
      }

      return -code error [appendArgs "invalid command name \"" $name \"]
    }

    namespace eval ::tcl::tm {
      #
      # NOTE: Ideally, this procedure should be created in the "::tcl::tm"
      #       namespace.
      #
2193
2194
2195
2196
2197
2198
2199










2200
2201
2202
2203
2204
2205
2206

    proc tclLog { string } {
      #
      # NOTE: This should work properly in both Tcl and Eagle.
      #
      catch {puts stderr $string}
    }











    proc makeVariableFast { name fast } {
      #
      # NOTE: This should work properly in Eagle only.
      #
      catch {
        uplevel 1 [list object invoke -flags +NonPublic \







>
>
>
>
>
>
>
>
>
>







2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353

    proc tclLog { string } {
      #
      # NOTE: This should work properly in both Tcl and Eagle.
      #
      catch {puts stderr $string}
    }

    proc makeProcedureFast { name fast } {
      #
      # NOTE: This should work properly in Eagle only.
      #
      catch {
        uplevel 1 [list object invoke -flags +NonPublic \
            Interpreter.GetActive MakeProcedureFast $name $fast]
      }
    }

    proc makeVariableFast { name fast } {
      #
      # NOTE: This should work properly in Eagle only.
      #
      catch {
        uplevel 1 [list object invoke -flags +NonPublic \
2239
2240
2241
2242
2243
2244
2245
















































2246
2247
2248
2249
2250
2251
2252
          }
        }
      }

      foreach dir [split [exec -unicode $::env(ComSpec) /u /c dir \
          /ahd /b [appendArgs \" [file nativename $pattern] \"]] \n] {
        set dir [string trim $dir]

















































        if {[string length $dir] > 0} then {
          set dir [getDirResultPath $pattern $dir]

          if {[lsearch -variable -exact -nocase result $dir] == -1} then {
            lappend result $dir
          }







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







2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
          }
        }
      }

      foreach dir [split [exec -unicode $::env(ComSpec) /u /c dir \
          /ahd /b [appendArgs \" [file nativename $pattern] \"]] \n] {
        set dir [string trim $dir]

        if {[string length $dir] > 0} then {
          set dir [getDirResultPath $pattern $dir]

          if {[lsearch -variable -exact -nocase result $dir] == -1} then {
            lappend result $dir
          }
        }
      }

      return $result
    }

    proc findDirectoriesRecursive { pattern } {
      #
      # NOTE: Block non-Windows platforms since this is Windows specific.
      #
      if {![isWindows]} then {
        error "not supported on this operating system"
      }

      #
      # NOTE: This should work properly in Eagle only.
      #
      set dir ""; set result [list]

      #
      # HACK: Optimize the variable access in this procedure to be
      #       as fast as possible.
      #
      makeVariableFast dir true; makeVariableFast result true

      foreach dir [split [exec -unicode $::env(ComSpec) /u /c dir \
          /ad /s /b [appendArgs \" [file nativename $pattern] \"]] \n] {
        set dir [string trim $dir]

        if {[string length $dir] > 0} then {
          set dir [getDirResultPath $pattern $dir]

          if {[lsearch -variable -exact -nocase result $dir] == -1} then {
            lappend result $dir
          }
        }
      }

      foreach dir [split [exec -unicode $::env(ComSpec) /u /c dir \
          /ahd /s /b [appendArgs \" [file nativename $pattern] \"]] \n] {
        set dir [string trim $dir]

        if {[string length $dir] > 0} then {
          set dir [getDirResultPath $pattern $dir]

          if {[lsearch -variable -exact -nocase result $dir] == -1} then {
            lappend result $dir
          }
2393
2394
2395
2396
2397
2398
2399




































































2400
2401
2402
2403
2404
2405
2406
          [file normalize $pattern]]

      eval lappend result [glob -nocomplain -types {d hidden} \
          [file normalize $pattern]]

      return $result
    }





































































    proc findFiles { pattern } {
      #
      # NOTE: This should work properly in Tcl only.
      #
      eval lappend result [glob -nocomplain -types {f} \
          [file normalize $pattern]]







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







2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
          [file normalize $pattern]]

      eval lappend result [glob -nocomplain -types {d hidden} \
          [file normalize $pattern]]

      return $result
    }

    proc findDirectoriesRecursive { pattern } {
      #
      # NOTE: Block non-Windows platforms since this is Windows specific.
      #
      if {![isWindows]} then {
        error "not supported on this operating system"
      }

      #
      # NOTE: This should work properly in Tcl only.
      #
      set result [list]

      catch {
        foreach dir [split [exec $::env(ComSpec) /c dir /ad /s /b \
            [file nativename $pattern]] \n] {
          set dir [string trim $dir]

          if {[string length $dir] > 0} then {
            set dir [getDirResultPath $pattern $dir]

            #
            # HACK: The -nocase option to [lsearch] is only available
            #       starting with Tcl 8.5.
            #
            if {$::tcl_version >= 8.5} then {
              if {[lsearch -exact -nocase $result $dir] == -1} then {
                lappend result $dir
              }
            } else {
              if {[lsearch -exact [string tolower $result] \
                  [string tolower $dir]] == -1} then {
                lappend result $dir
              }
            }
          }
        }
      }

      catch {
        foreach dir [split [exec $::env(ComSpec) /c dir /ahd /s /b \
            [file nativename $pattern]] \n] {
          set dir [string trim $dir]

          if {[string length $dir] > 0} then {
            set dir [getDirResultPath $pattern $dir]

            #
            # HACK: The -nocase option to [lsearch] is only available
            #       starting with Tcl 8.5.
            #
            if {$::tcl_version >= 8.5} then {
              if {[lsearch -exact -nocase $result $dir] == -1} then {
                lappend result $dir
              }
            } else {
              if {[lsearch -exact [string tolower $result] \
                  [string tolower $dir]] == -1} then {
                lappend result $dir
              }
            }
          }
        }
      }

      return $result
    }

    proc findFiles { pattern } {
      #
      # NOTE: This should work properly in Tcl only.
      #
      eval lappend result [glob -nocomplain -types {f} \
          [file normalize $pattern]]
2428
2429
2430
2431
2432
2433
2434





2435
2436






2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449





2450
2451






2452
2453
2454
2455
2456
2457
2458
        foreach fileName [split [exec $::env(ComSpec) /c dir /a-d /s /b \
            [file nativename $pattern]] \n] {
          set fileName [string trim $fileName]

          if {[string length $fileName] > 0} then {
            set fileName [getDirResultPath $pattern $fileName]






            if {[lsearch -exact -nocase $result $fileName] == -1} then {
              lappend result $fileName






            }
          }
        }
      }

      catch {
        foreach fileName [split [exec $::env(ComSpec) /c dir /ah-d /s /b \
            [file nativename $pattern]] \n] {
          set fileName [string trim $fileName]

          if {[string length $fileName] > 0} then {
            set fileName [getDirResultPath $pattern $fileName]






            if {[lsearch -exact -nocase $result $fileName] == -1} then {
              lappend result $fileName






            }
          }
        }
      }

      return $result
    }







>
>
>
>
>


>
>
>
>
>
>













>
>
>
>
>


>
>
>
>
>
>







2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
        foreach fileName [split [exec $::env(ComSpec) /c dir /a-d /s /b \
            [file nativename $pattern]] \n] {
          set fileName [string trim $fileName]

          if {[string length $fileName] > 0} then {
            set fileName [getDirResultPath $pattern $fileName]

            #
            # HACK: The -nocase option to [lsearch] is only available
            #       starting with Tcl 8.5.
            #
            if {$::tcl_version >= 8.5} then {
            if {[lsearch -exact -nocase $result $fileName] == -1} then {
              lappend result $fileName
              }
            } else {
              if {[lsearch -exact [string tolower $result] \
                  [string tolower $fileName]] == -1} then {
                lappend result $fileName
              }
            }
          }
        }
      }

      catch {
        foreach fileName [split [exec $::env(ComSpec) /c dir /ah-d /s /b \
            [file nativename $pattern]] \n] {
          set fileName [string trim $fileName]

          if {[string length $fileName] > 0} then {
            set fileName [getDirResultPath $pattern $fileName]

            #
            # HACK: The -nocase option to [lsearch] is only available
            #       starting with Tcl 8.5.
            #
            if {$::tcl_version >= 8.5} then {
            if {[lsearch -exact -nocase $result $fileName] == -1} then {
              lappend result $fileName
              }
            } else {
              if {[lsearch -exact [string tolower $result] \
                  [string tolower $fileName]] == -1} then {
                lappend result $fileName
              }
            }
          }
        }
      }

      return $result
    }
2510
2511
2512
2513
2514
2515
2516
2517
2518

2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
        isSameFileName getEnvironmentVariable combineFlags getCompileInfo \
        getPlatformInfo getPluginPath appendArgs lappendArgs \
        getDictionaryValue getColumnValue getRowColumnValue tqputs tqlog \
        readFile readSharedFile writeFile appendFile appendLogFile \
        appendSharedFile appendSharedLogFile readAsciiFile writeAsciiFile \
        readUnicodeFile writeUnicodeFile getDirResultPath addToPath \
        removeFromPath execShell lshuffle ldifference filter map reduce \
        getLengthModifier debug findDirectories findFiles findFilesRecursive \
        exportAndImportPackageCommands] false false


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







|
|
>













2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
        isSameFileName getEnvironmentVariable combineFlags getCompileInfo \
        getPlatformInfo getPluginPath appendArgs lappendArgs \
        getDictionaryValue getColumnValue getRowColumnValue tqputs tqlog \
        readFile readSharedFile writeFile appendFile appendLogFile \
        appendSharedFile appendSharedLogFile readAsciiFile writeAsciiFile \
        readUnicodeFile writeUnicodeFile getDirResultPath addToPath \
        removeFromPath execShell lshuffle ldifference filter map reduce \
        getLengthModifier debug findDirectories findDirectoriesRecursive \
        findFiles findFilesRecursive exportAndImportPackageCommands] false \
        false

    ###########################################################################
    ############################## END Tcl ONLY ###############################
    ###########################################################################
  }

  #
  # NOTE: Provide the Eagle library package to the interpreter.
  #
  package provide Eagle.Library \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}

Changes to Externals/Eagle/lib/Eagle1.0/shell.eagle.
26
27
28
29
30
31
32












33

34



























































































35
36
37
38
39
40
41
    ###########################################################################

    #
    # NOTE: Commands specific to initializing the Eagle interactive shell
    #       environment should be placed here.
    #
    proc help { args } {












      eval lappend command #help $args; debug icommand $command

      error "for interactive help please use: #help $args"



























































































    }

    ###########################################################################
    ############################# END Eagle ONLY ##############################
    ###########################################################################
  } else {
    ###########################################################################







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

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







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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
    ###########################################################################

    #
    # NOTE: Commands specific to initializing the Eagle interactive shell
    #       environment should be placed here.
    #
    proc help { args } {
      host result Break [appendArgs \
          "\nFor interactive help please use: #help " $args \
          "\nFor commercial support, please use: #support\n"]

      catch {
        object invoke Interpreter.GetActive Host.WriteLine \
            "\nPlease press any key to continue...\n"

        set key null; object invoke Interpreter.GetActive \
            Host.ReadKey true key
      }

      eval lappend command #help $args; debug icommand $command
    }

    proc #support {} {
      # <help>
      # Shows the requirements for obtaining commercial support and/or
      # redirects to the appropriate web site using the default browser.
      # </help>

      if {[catch {
        package require Licensing.Enterprise
        set fileName(1) [certificate current]

        if {[string length $fileName(1)] == 0} then {
          error "No certificate file is available."
        }

        set certificate [certificate import -alias $fileName(1)]

        if {[string length $certificate] == 0} then {
          error [appendArgs \
              "No certificate is available, current file \"" \
              $fileName(1) "\" could not be imported."]
        }

        if {[catch {
          certificate flags -hasflags S -hasall -strict $certificate
        } error(2)]} then {
          error [appendArgs \
              "Support is not enabled for certificate \"" \
              [$certificate Id] " - " [$certificate EntityName] \
              "\", the original error message was: \{" $error(2) \
              \}.]
        }

        set uri [$certificate -create -alias Support]

        if {[string length $uri] == 0} then {
          error [appendArgs \
              "No support information found in certificate \"" \
              [$certificate Id] " - " [$certificate EntityName] \".]
        }

        if {[$uri Scheme] ni [list http https]} then {
          error [appendArgs \
              "Support URI scheme \"" [$uri Scheme] \
              "\" in certificate \"" [$certificate Id] " - " \
              [$certificate EntityName] "\" is not supported, " \
              "must be \"http\" or \"https\"."]
        }

        exec -shell [$uri ToString] &
      } error(1)]} then {
        set fileName(2) [file tempname]; set fileData ""

        foreach varName [lsort [info vars]] {
          if {$varName in [list fileData]} then {
            continue
          }

          if {$varName eq "certificate" && \
              [string length $certificate] > 0} then {
            append fileData [appendArgs \n \
                [list array set certificate \
                [$certificate -flags +NonPublic \
                ToDictionary.KeysAndValuesToString \
                null false]]]

            continue
          }

          if {[array exists $varName]} then {
            append fileData [appendArgs \n \
                [list array set $varName [array get $varName]]]
          } else {
            append fileData [appendArgs \n \
                [list set $varName [set $varName]]]
          }
        }

        append fileData \n; writeFile $fileName(2) $fileData
        set ::eagle_shell(errorFileName) $fileName(2)

        error [appendArgs \
            "\n\nIn order to obtain commercial support, at least " \
            "one of the\nfollowing requirements must be met:\n\n" \
            "\t1. Valid, non-expired commercial license agreement\n" \
            "\t   for Eagle Enterprise Edition.\n\n" \
            "\t2. Valid, non-expired commercial support contract\n" \
            "\t   for Eagle Standard Edition.\n\n" \
            "The original error information was saved to the file:\n\n" \
            [string repeat - 60] \n $fileName(2) \n [string repeat - 60] \
            "\n\nPlease provide this file when contacting support."]
      }
    }

    ###########################################################################
    ############################# END Eagle ONLY ##############################
    ###########################################################################
  } else {
    ###########################################################################
Changes to Externals/Eagle/lib/Eagle1.0/test.eagle.
233
234
235
236
237
238
239




240
241
242
243
244
245
246
    }
  }

  proc testArrayGet { varName {integer false} } {
    #
    # NOTE: Returns the results of [array get] in a well-defined order.
    #




    upvar 1 $varName array

    #
    # NOTE: Build the command that will sort the array names into order.
    #
    set command [list lsort]
    if {$integer} then {lappend command -integer}







>
>
>
>







233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
    }
  }

  proc testArrayGet { varName {integer false} } {
    #
    # NOTE: Returns the results of [array get] in a well-defined order.
    #
    if {[string length $varName] == 0} then {
      return [list]
    }

    upvar 1 $varName array

    #
    # NOTE: Build the command that will sort the array names into order.
    #
    set command [list lsort]
    if {$integer} then {lappend command -integer}
477
478
479
480
481
482
483
484





485
486
487
488

489
490
491

492
493
494
495
496
497
498

499
500
501
502
503
504
505
        tputs $::test_channel [appendArgs \
            "---- skipped " $type " file: \"" $fileName \
            "\", it does not exist\n"]
      }
    }
  }

  proc processTestArguments { varName args } {





    #
    # NOTE: We are going to place the configured options in the variable
    #       identified by the name provided by the caller.
    #

    upvar 1 $varName array

    #

    # TODO: Add more support for standard tcltest options here.
    #
    set options [list \
        -breakOnLeak -configuration -constraints -exitOnComplete -file \
        -logFile -machine -match -no -notFile -platform -postTest -preTest \
        -postWait -preWait -randomOrder -skip -startFile -stopFile \
        -stopOnFailure -stopOnLeak -suffix -suite -tclsh -threshold]


    set length [llength $args]

    for {set index 0} {$index < $length} {incr index} {
      #
      # NOTE: Grab the current list element, which should be the name of
      #       the test option.







|
>
>
>
>
>




>

|
|
>
|


|
|
|
|
>







481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
        tputs $::test_channel [appendArgs \
            "---- skipped " $type " file: \"" $fileName \
            "\", it does not exist\n"]
      }
    }
  }

  proc processTestArguments { varName strict args } {
    #
    # NOTE: Initially, there are no unknown (i.e. unprocessed) arguments.
    #
    set result [list]

    #
    # NOTE: We are going to place the configured options in the variable
    #       identified by the name provided by the caller.
    #
    if {[string length $varName] > 0} then {
    upvar 1 $varName array
    }

    #
    # TODO: Add more support for standard "tcltest" options here.
    #
    set options [list \
        -breakOnLeak -configuration -constraints -exitOnComplete \
        -file -logFile -machine -match -no -notFile -platform \
        -postTest -preTest -postWait -preWait -randomOrder -skip \
        -startFile -stopFile -stopOnFailure -stopOnLeak -suffix \
        -suite -tclsh -threshold]

    set length [llength $args]

    for {set index 0} {$index < $length} {incr index} {
      #
      # NOTE: Grab the current list element, which should be the name of
      #       the test option.
535
536
537
538
539
540
541




542







543
544

545


546
547
548
























549
550
551
552
553
554


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
580
581
582
583
        # NOTE: Is there another list element available for the value?  If
        #       not, it does not conform to the standard command line name
        #       and value pattern.
        #
        if {$index + 1 < $length} then {
          incr index; set value [lindex $args $index]





          tqputs $::test_channel [appendArgs \







              "---- unknown test option \"" $name "\" with value \"" \
              $value "\" ignored\n"]

        } else {


          tqputs $::test_channel [appendArgs \
              "---- no value for unknown test option \"" $name \
              "\" ignored\n"]
























        }
      } else {
        #
        # NOTE: This is not an option of *any* kind that we know about.
        #       Ignore it and issue a warning.
        #


        tqputs $::test_channel [appendArgs \
            "---- unknown argument \"" $name "\" ignored\n"]

      }
    }

    #
    # NOTE: Now, attempt to flush the test log queue, if available.
    #
    tlog ""






  }

  proc getTclShellFileName { automatic kits } {
    #
    # NOTE: Start out with an empty list of candiate Tcl shells.
    #
    set shells [list]

    #
    # NOTE: Check all environment variables we know about that
    #       may contain the path where the Tcl shell is located.
    #
    foreach name [list Eagle_Tcl_Shell Tcl_Shell] {
      set value [getEnvironmentVariable $name]

      #
      # TODO: Possibly add a check if the file actually exists
      #       here.
      #
      if {[string length $value] > 0} then {







>
>
>
>

>
>
>
>
>
>
>

|
>

>
>


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






>
>

|
>







>
>
>
>
>
>












|







547
548
549
550
551
552
553
554
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
        # NOTE: Is there another list element available for the value?  If
        #       not, it does not conform to the standard command line name
        #       and value pattern.
        #
        if {$index + 1 < $length} then {
          incr index; set value [lindex $args $index]

          if {!$strict && [lsearch -exact $options $value] != -1} then {
            incr index -1; # HACK: Resynchronize with valid test option.
            lappend result [list $name]

          tqputs $::test_channel [appendArgs \
                "---- no value for unknown test option \"" $name \
                "\", ignored, backing up one for test option \"" \
                $value \"...\n]
          } else {
            lappend result [list $name $value]

            tqputs $::test_channel [appendArgs \
              "---- unknown test option \"" $name "\" with value \"" \
                $value "\", ignored\n"]
          }
        } else {
          lappend result [list $name]

          tqputs $::test_channel [appendArgs \
              "---- no value for unknown test option \"" $name \
              "\", ignored\n"]
        }
      } else {
        #
        # NOTE: Is there another list element available for the value?  If
        #       not, it does not conform to the standard command line name
        #       and value pattern.
        #
        if {$index + 1 < $length} then {
          incr index; set value [lindex $args $index]

          if {!$strict && [lsearch -exact $options $value] != -1} then {
            incr index -1; # HACK: Resynchronize with valid test argument.
            lappend result [list $name]

            tqputs $::test_channel [appendArgs \
                "---- no value for unknown argument \"" $name \
                "\", ignored, backing up one for test option \"" \
                $value \"...\n]
          } else {
            lappend result [list $name $value]

            tqputs $::test_channel [appendArgs \
                "---- unknown argument \"" $name "\" with value \"" \
                $value "\", ignored\n"]
        }
      } else {
        #
        # NOTE: This is not an option of *any* kind that we know about.
        #       Ignore it and issue a warning.
        #
          lappend result [list $name]

        tqputs $::test_channel [appendArgs \
              "---- unknown argument \"" $name "\", ignored\n"]
        }
      }
    }

    #
    # NOTE: Now, attempt to flush the test log queue, if available.
    #
    tlog ""

    #
    # NOTE: Return the nested list of unknown arguments, formatted as
    #       name/value pairs, to the caller.
    #
    return $result
  }

  proc getTclShellFileName { automatic kits } {
    #
    # NOTE: Start out with an empty list of candiate Tcl shells.
    #
    set shells [list]

    #
    # NOTE: Check all environment variables we know about that
    #       may contain the path where the Tcl shell is located.
    #
    foreach name [list Eagle_Tcl_Shell Tcl_Shell EAGLE_TCLSH TCLSH] {
      set value [getEnvironmentVariable $name]

      #
      # TODO: Possibly add a check if the file actually exists
      #       here.
      #
      if {[string length $value] > 0} then {
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
    if {![info exists ::no(epilogue.eagle)] && [info exists ::path]} then {
      unset ::path
    }
  }

  proc hookPuts {} {
    #
    # NOTE: This code was stolen from tcltest and heavily modified to work
    #       with Eagle.
    #
    proc [namespace current]::testPuts { args } {
      switch [llength $args] {
        1 {
          #
          # NOTE: Only the string to be printed is specified (stdout).
          #







|
|







1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
    if {![info exists ::no(epilogue.eagle)] && [info exists ::path]} then {
      unset ::path
    }
  }

  proc hookPuts {} {
    #
    # NOTE: This code was stolen from "tcltest" and heavily modified to
    #       work with Eagle.
    #
    proc [namespace current]::testPuts { args } {
      switch [llength $args] {
        1 {
          #
          # NOTE: Only the string to be printed is specified (stdout).
          #
2313
2314
2315
2316
2317
2318
2319
2320


















































































































































































































































2321






2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
  proc isTestSuiteRunning {} {
    #
    # NOTE: Return non-zero if the test suite appears to be running.
    #
    return [expr {[info exists ::test_suite_running] && \
        $::test_suite_running}]
  }



















































































































































































































































  proc configureTcltest { match skip constraints imports force } {






    if {[isEagle]} then {
      #
      # HACK: Flag the "test" and "runTest" script library procedures so
      #       that they use the script location of their caller and not
      #       their own.
      #
      # BUGBUG: Even this does not yet fix the script location issues in
      #         the test suite:
      #
      #         debug procedureflags test +ScriptLocation
      #         debug procedureflags runTest +ScriptLocation
      #
      # NOTE: Setup the necessary compatibility shims for the test suite.
      #
      namespace eval ::tcltest {}; # HACK: Force namespace creation now.
      setupTestShims true [expr {![isTestSuiteRunning]}]

      #
      # NOTE: Fake having the tcltest package.
      #
      package provide tcltest 2.2.10; # Tcl 8.4
    } else {
      #
      # NOTE: Attempt to detect if the tcltest package is already loaded.
      #
      set loaded [expr {[catch {package present tcltest}] == 0}]

      #
      # NOTE: Always attempt to load the tcltest package.
      #
      package require tcltest

      #
      # NOTE: Configure tcltest for our use (only when it was not loaded).
      #
      if {!$loaded} then {
        ::tcltest::configure -verbose bpste
      }

      #
      # NOTE: We need to copy the Eagle test names to match over to Tcl.








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

>
>
>
>
>
>


















|


|

|




|




|







2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
  proc isTestSuiteRunning {} {
    #
    # NOTE: Return non-zero if the test suite appears to be running.
    #
    return [expr {[info exists ::test_suite_running] && \
        $::test_suite_running}]
  }

  proc getTestChannelOrDefault {} {
    if {[info exists ::test_channel]} then {
      return $::test_channel
    }

    return stdout; # TODO: Good default?
  }

  proc checkForAndSetTestPath { whatIf {quiet false} } {
    #
    # NOTE: Everything in this procedure requires access to the file system;
    #       therefore, it cannot be used in a stock "safe" interpreter.
    #
    if {![interp issafe] && ![info exists ::test_path]} then {
      #
      # NOTE: Grab the name of the current script file.  If this is an empty
      #       string, many test path checks will have to be skipped.
      #
      set script [info script]

      #
      # NOTE: Eagle and native Tcl have different requirements and possible
      #       locations for the test path; therefore, handle them separately.
      #
      if {[isEagle]} then {
        #
        # NOTE: Grab the base directory and the library directory.  Without
        #       these, several test path checks will be skipped.
        #
        set library [getTestLibraryDirectory]; set base [info base]

        if {[string length $library] > 0} then {
          #
          # NOTE: Try the source release directory structure.  For this
          #       case, the final test path would be:
          #
          #           $library/../../Library/Tests
          #
          set ::test_path [file normalize [file join [file dirname [file \
              dirname $library]] Library Tests]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #1 for Eagle test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $base] > 0 && ($whatIf || \
            ![info exists ::test_path] || ![file exists $::test_path] || \
            ![file isdirectory $::test_path])} then {
          #
          # NOTE: Try the source release directory structure again; this
          #       time, assume only the embedded script library was used.
          #       For this case, the final test path would be:
          #
          #           $base/Library/Tests
          #
          set ::test_path [file normalize [file join $base Library Tests]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #2 for Eagle test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $script] > 0 && ($whatIf || \
            ![info exists ::test_path] || ![file exists $::test_path] || \
            ![file isdirectory $::test_path])} then {
          #
          # NOTE: Try for the test package directory.  For this case, the
          #       final test path would be:
          #
          #           $script/../Test1.0
          #
          set ::test_path [file normalize [file join [file dirname [file \
              dirname $script]] [appendArgs Test [info engine Version]]]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #3 for Eagle test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $base] > 0 && ($whatIf || \
            ![info exists ::test_path] || ![file exists $::test_path] || \
            ![file isdirectory $::test_path])} then {
          #
          # NOTE: Try for the test package directory again; this time, use
          #       the base path and assume the source release directory
          #       structure.  For this case, the final test path would be:
          #
          #           $base/lib/Test1.0
          #
          set ::test_path [file normalize [file join $base lib [appendArgs \
              Test [info engine Version]]]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #4 for Eagle test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $base] > 0 && ($whatIf || \
            ![info exists ::test_path] || ![file exists $::test_path] || \
            ![file isdirectory $::test_path])} then {
          #
          # NOTE: Try for the test package directory again; this time, use
          #       the base path.  For this case, the final test path would
          #       be:
          #
          #           $base/Test1.0
          #
          set ::test_path [file normalize [file join $base [appendArgs \
              Test [info engine Version]]]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #5 for Eagle test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $library] > 0 && ($whatIf || \
            ![info exists ::test_path] || ![file exists $::test_path] || \
            ![file isdirectory $::test_path])} then {
          #
          # NOTE: This must be a binary release, no "Library" directory
          #       then.  Also, binary releases have an upper-case "Tests"
          #       directory name that originates from the "update.bat"
          #       tool.  This must match the casing used in "update.bat".
          #       For this case, the final test path would be:
          #
          #           $library/../../Tests
          #
          set ::test_path [file normalize [file join [file dirname [file \
              dirname $library]] Tests]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #6 for Eagle test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $base] > 0 && ($whatIf || \
            ![info exists ::test_path] || ![file exists $::test_path] || \
            ![file isdirectory $::test_path])} then {
          #
          # NOTE: Fallback to using the base directory and checking for a
          #       "Tests" directory beneath it.  For this case, the final
          #       test path would be:
          #
          #           $base/Tests
          #
          set ::test_path [file normalize [file join $base Tests]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #7 for Eagle test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {!$quiet} then {
          tqputs [getTestChannelOrDefault] [appendArgs \
              "---- final Eagle test path is \"" \
              [expr {[info exists ::test_path] ? \
              $::test_path : "<none>"}] \"\n]
        }
      } else {
        if {[string length $script] > 0} then {
          #
          # NOTE: Try the source release directory structure.  For this
          #       case, the final test path would be:
          #
          #           $script/../../Library/Tests
          #
          set ::test_path [file normalize [file join [file dirname [file \
              dirname [file dirname $script]]] Library Tests]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #1 for Tcl test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $script] > 0 && ($whatIf || \
            ![info exists ::test_path] || ![file exists $::test_path] || \
            ![file isdirectory $::test_path])} then {
          #
          # NOTE: Try for the test package directory.  For this case, the
          #       final test path would be:
          #
          #           $script/../Test1.0
          #
          set ::test_path [file normalize [file join [file dirname [file \
              dirname $script]] Test1.0]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #2 for Tcl test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {[string length $script] > 0 && ($whatIf || \
            ![info exists ::test_path] || ![file exists $::test_path] || \
            ![file isdirectory $::test_path])} then {
          #
          # NOTE: This must be a binary release, no "Library" directory
          #       then.  Also, binary releases have an upper-case "Tests"
          #       directory name that originates from the "update.bat"
          #       tool.  This must match the casing used in "update.bat".
          #       For this case, the final test path would be:
          #
          #           $script/../../Tests
          #
          set ::test_path [file normalize [file join [file dirname [file \
              dirname [file dirname $script]]] Tests]]

          if {!$quiet} then {
            tqputs [getTestChannelOrDefault] [appendArgs \
                "---- checking #3 for Tcl test path at \"" \
                $::test_path \"...\n]
          }
        }

        if {!$quiet} then {
          tqputs [getTestChannelOrDefault] [appendArgs \
              "---- final Tcl test path is \"" \
              [expr {[info exists ::test_path] ? \
              $::test_path : "<none>"}] \"\n]
        }
      }
    }
  }

  proc configureTcltest { match skip constraints imports force } {
    #
    # NOTE: Eagle and native Tcl have different configuration requirements
    #       for the "tcltest" package.  For Eagle, the necessary testing
    #       functionality is built-in.  In native Tcl, the package must be
    #       loaded now and that cannot be done in a "safe" interpreter.
    #
    if {[isEagle]} then {
      #
      # HACK: Flag the "test" and "runTest" script library procedures so
      #       that they use the script location of their caller and not
      #       their own.
      #
      # BUGBUG: Even this does not yet fix the script location issues in
      #         the test suite:
      #
      #         debug procedureflags test +ScriptLocation
      #         debug procedureflags runTest +ScriptLocation
      #
      # NOTE: Setup the necessary compatibility shims for the test suite.
      #
      namespace eval ::tcltest {}; # HACK: Force namespace creation now.
      setupTestShims true [expr {![isTestSuiteRunning]}]

      #
      # NOTE: Fake having the package as the functionality is built-in.
      #
      package provide tcltest 2.2.10; # Tcl 8.4
    } elseif {![interp issafe]} then {
      #
      # NOTE: Attempt to detect if the package is already loaded.
      #
      set loaded [expr {[catch {package present tcltest}] == 0}]

      #
      # NOTE: Always attempt to load the package.
      #
      package require tcltest

      #
      # NOTE: Configure it for our use (only when it was not loaded).
      #
      if {!$loaded} then {
        ::tcltest::configure -verbose bpste
      }

      #
      # NOTE: We need to copy the Eagle test names to match over to Tcl.
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548

        if {[info exists test_flags(-constraints)]} then {
            eval lappend eagle_tests(Constraints) $test_flags(-constraints)
        }
      }
    }

    proc getTestChannelOrDefault {} {
      if {[info exists ::test_channel]} then {
        return $::test_channel
      }

      return stdout; # TODO: Good default?
    }

    proc setupTestShims { setup {quiet false} } {
      if {$setup} then {
        #
        # HACK: Compatibility shim(s) for use with various tests in the Tcl
        #       test suite.  Make sure these commands do not already exist
        #       prior to attempt to adding them.
        #







<
<
<
<
<
<
<
<







2834
2835
2836
2837
2838
2839
2840








2841
2842
2843
2844
2845
2846
2847

        if {[info exists test_flags(-constraints)]} then {
            eval lappend eagle_tests(Constraints) $test_flags(-constraints)
        }
      }
    }









    proc setupTestShims { setup {quiet false} } {
      if {$setup} then {
        #
        # HACK: Compatibility shim(s) for use with various tests in the Tcl
        #       test suite.  Make sure these commands do not already exist
        #       prior to attempt to adding them.
        #
3088
3089
3090
3091
3092
3093
3094
3095

3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
      object unimport -importpattern System.Windows.Forms.Layout
      object unimport -importpattern System.Windows.Forms.PropertyGridInternal
      object unimport -importpattern System.Windows.Forms.VisualStyles
    }

    proc getTestLibraryDirectory {} {
      #
      # NOTE: First, query the location of the script library.

      #
      set result [info library]

      #
      # NOTE: Next, If the script library is embedded within the core
      #       library itself (i.e. the script library location refers
      #       to a file, not a directory), strip off the file name.
      #
      if {[file exists $result] && [file isfile $result]} then {
        set result [file dirname $result]
      }

      #
      # NOTE: Finally, return the resulting script library directory.
      #
      return $result
    }

    #
    # NOTE: Setup the test path relative to the library path.
    #
    if {![interp issafe] && ![info exists ::test_path]} then {
      #
      # NOTE: Try the source release directory structure.  For this case,
      #       the final test path would be:
      #
      #           $library/../../Library/Tests
      #
      set ::test_path [file join [file normalize [file dirname \
          [file dirname [getTestLibraryDirectory]]]] Library Tests]

      if {![file exists $::test_path] || \
          ![file isdirectory $::test_path]} then {
        #
        # NOTE: Try the source release directory structure again; this time,
        #       assume only the embedded script library was used.  For this
        #       case, the final test path would be:
        #
        #           $base/Library/Tests
        #
        set ::test_path [file join [info base] Library Tests]
      }

      if {![file exists $::test_path] || \
          ![file isdirectory $::test_path]} then {
        #
        # NOTE: Try for the test package directory.  For this case, the final
        #       test path would be:
        #
        #           $script/../Test1.0
        #
        set ::test_path [file join [file normalize [file dirname \
            [file dirname [info script]]]] [appendArgs Test \
            [info engine Version]]]
      }

      if {![file exists $::test_path] || \
          ![file isdirectory $::test_path]} then {
        #
        # NOTE: Try for the test package directory again; this time, use the
        #       base path and assume the source release directory structure.
        #       For this case, the final test path would be:
        #
        #           $base/lib/Test1.0
        #
        set ::test_path [file join [info base] lib [appendArgs Test \
            [info engine Version]]]
      }

      if {![file exists $::test_path] || \
          ![file isdirectory $::test_path]} then {
        #
        # NOTE: Try for the test package directory again; this time, use the
        #       base path.  For this case, the final test path would be:
        #
        #           $base/Test1.0
        #
        set ::test_path [file join [info base] [appendArgs Test \
            [info engine Version]]]
      }

      if {![file exists $::test_path] || \
          ![file isdirectory $::test_path]} then {
        #
        # NOTE: This must be a binary release, no "Library" directory then.
        #       Also, binary releases have an upper-case "Tests" directory
        #       name that originates from the "update.bat" tool.  This must
        #       match the casing used in "update.bat".  For this case, the
        #       final test path would be:
        #
        #           $library/../../Tests
        #
        set ::test_path [file join [file normalize [file dirname \
            [file dirname [getTestLibraryDirectory]]]] Tests]
      }

      if {![file exists $::test_path] || \
          ![file isdirectory $::test_path]} then {
        #
        # NOTE: Fallback to using the base directory and checking for a
        #       "Tests" directory beneath it.  For this case, the final
        #       test path would be:
        #
        #           $base/Tests
        #
        set ::test_path [file join [info base] Tests]
      }
    }

    #
    # NOTE: Fake having the tcltest package unless we are prevented.
    #
    if {![info exists ::no(configureTcltest)]} then {
      configureTcltest [list] [list] [list] [list] false
    }

    ###########################################################################
    ############################# END Eagle ONLY ##############################







|
>

<
|















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


<
<

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

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


<
<

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







3387
3388
3389
3390
3391
3392
3393
3394
3395
3396

3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412












3413










3414
3415


3416









3417







3418
3419



3420











3421













3422
3423


3424









3425

3426
3427
3428
3429
3430
3431
3432
3433
      object unimport -importpattern System.Windows.Forms.Layout
      object unimport -importpattern System.Windows.Forms.PropertyGridInternal
      object unimport -importpattern System.Windows.Forms.VisualStyles
    }

    proc getTestLibraryDirectory {} {
      #
      # NOTE: First, query the location of the script library.  This will
      #       not work right in a "safe" interpreter.
      #

      if {[catch {info library} result] == 0} then {
      #
      # NOTE: Next, If the script library is embedded within the core
      #       library itself (i.e. the script library location refers
      #       to a file, not a directory), strip off the file name.
      #
      if {[file exists $result] && [file isfile $result]} then {
        set result [file dirname $result]
      }

      #
      # NOTE: Finally, return the resulting script library directory.
      #
      return $result
    }













      return ""










      }



        #









    # NOTE: Check for the test path in the various well-known locations







    #       and set the associated variable.
        #



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











      checkForAndSetTestPath false [expr {![isTestSuiteRunning]}]













      }



        #









    # NOTE: Fake loading and configuring the "tcltest" package unless we

    #       are prevented.
    #
    if {![info exists ::no(configureTcltest)]} then {
      configureTcltest [list] [list] [list] [list] false
    }

    ###########################################################################
    ############################# END Eagle ONLY ##############################
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
            double($::tcltest::numTests(Total)))}]
      }

      return 0; # no tests were run, etc.
    }

    #
    # NOTE: Setup the test path relative to the path of this file.
    #
    if {![interp issafe] && ![info exists ::test_path]} then {
      #
      # NOTE: Try the source release directory structure.
      #
      set ::test_path [file join [file normalize [file dirname \
          [file dirname [file dirname [info script]]]]] Library Tests]

      if {![file exists $::test_path] || \
          ![file isdirectory $::test_path]} then {
        #
        # NOTE: Try for the test package directory.
        #
        set ::test_path [file join [file normalize [file dirname \
            [file dirname [info script]]]] Test1.0]
      }

      if {![file exists $::test_path] || \
          ![file isdirectory $::test_path]} then {
        #
        # NOTE: This must be a binary release, no "Library" directory then.
        #       Also, binary releases have an upper-case "Tests" directory
        #       name that originates from the "update.bat" tool.  This must
        #       match the casing used in "update.bat".
        #
        set ::test_path [file join [file normalize [file dirname \
            [file dirname [file dirname [info script]]]]] Tests]
      }
    }

    #
    # NOTE: Load and configure the tcltest package unless we are prevented.
    #
    if {![interp issafe] && ![info exists ::no(configureTcltest)]} then {
      configureTcltest [list] [list] [list] [list test testConstraint] false
    }

    #
    # NOTE: We need several of our test related commands in the global
    #       namespace as well.
    #







|
<
<
<
<
<
<
<
|
<
<

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

|
|
<
|

|







3455
3456
3457
3458
3459
3460
3461
3462







3463


3464



3465

3466










3467
3468
3469

3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
            double($::tcltest::numTests(Total)))}]
      }

      return 0; # no tests were run, etc.
    }

    #
    # NOTE: Check for the test path in the various well-known locations







    #       and set the associated variable.


        #



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

      checkForAndSetTestPath false [expr {![isTestSuiteRunning]}]










      }

    #

    # NOTE: Load and configure the "tcltest" package unless we are prevented.
    #
    if {![info exists ::no(configureTcltest)]} then {
      configureTcltest [list] [list] [list] [list test testConstraint] false
    }

    #
    # NOTE: We need several of our test related commands in the global
    #       namespace as well.
    #
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
        getTestSuffix testExec testClrExec execTestShell isRandomOrder \
        isBreakOnLeak isStopOnFailure isStopOnLeak isExitOnComplete \
        returnInfoScript runTestPrologue runTestEpilogue hookPuts unhookPuts \
        runTest testDebugBreak testArrayGet testShim tsource \
        recordTestStatistics reportTestStatistics formatList formatListAsDict \
        pathToRegexp inverseLsearchGlob removePathFromFileNames formatDecimal \
        clearTestPercent reportTestPercent runAllTests isTestSuiteRunning \
        configureTcltest machineToPlatform getPassPercentage \
        getSkipPercentage] false false

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







|
|













3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
        getTestSuffix testExec testClrExec execTestShell isRandomOrder \
        isBreakOnLeak isStopOnFailure isStopOnLeak isExitOnComplete \
        returnInfoScript runTestPrologue runTestEpilogue hookPuts unhookPuts \
        runTest testDebugBreak testArrayGet testShim tsource \
        recordTestStatistics reportTestStatistics formatList formatListAsDict \
        pathToRegexp inverseLsearchGlob removePathFromFileNames formatDecimal \
        clearTestPercent reportTestPercent runAllTests isTestSuiteRunning \
        getTestChannelOrDefault checkForAndSetTestPath configureTcltest \
        machineToPlatform getPassPercentage getSkipPercentage] false false

    ###########################################################################
    ############################## END Tcl ONLY ###############################
    ###########################################################################
  }

  #
  # NOTE: Provide the Eagle test package to the interpreter.
  #
  package provide Eagle.Test \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}

Changes to Externals/Eagle/lib/Test1.0/all.eagle.
38
39
40
41
42
43
44





45
46


47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
#
#       When using the above code snippet, the following code snippet may also
#       be used at the very end of the corresponding "all.eagle" file instead
#       of evaluating the "epilogue.eagle" file directly:
#
#           runTestEpilogue
#





if {![info exists test_path]} then {
  set test_path [file normalize [file dirname [info script]]]


}

source [file join $test_path prologue.eagle]

set no(prologue.eagle) true
set no(epilogue.eagle) true

set test_time [time {
  runAllTests $test_channel $test_path \
      [getTestFiles [list $test_path] $test_flags(-file) \
          $test_flags(-notFile)] \
      [list [file tail [info script]] *.tcl pkgIndex.eagle \
          constraints.eagle epilogue.eagle prologue.eagle] \
      $test_flags(-startFile) $test_flags(-stopFile)
}]

tputs $test_channel [appendArgs "---- all tests completed in " $test_time \n]
unset test_time

unset no(epilogue.eagle)
unset no(prologue.eagle)

if {[array size no] == 0} then {unset no}

source [file join $test_path epilogue.eagle]







>
>
>
>
>

|
>
>


|








|
|











|
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
#
#       When using the above code snippet, the following code snippet may also
#       be used at the very end of the corresponding "all.eagle" file instead
#       of evaluating the "epilogue.eagle" file directly:
#
#           runTestEpilogue
#
if {![info exists test_all_path]} then {
  set test_all_path \
      [file normalize [file dirname [info script]]]
}

if {![info exists test_path]} then {
  set test_path [file normalize [file join \
      [file dirname [file dirname $test_all_path]] \
      Library Tests]]
}

source [file join $test_all_path prologue.eagle]

set no(prologue.eagle) true
set no(epilogue.eagle) true

set test_time [time {
  runAllTests $test_channel $test_path \
      [getTestFiles [list $test_path] $test_flags(-file) \
          $test_flags(-notFile)] \
      [list [file tail [info script]] *.tcl \
          epilogue.eagle prologue.eagle] \
      $test_flags(-startFile) $test_flags(-stopFile)
}]

tputs $test_channel [appendArgs "---- all tests completed in " $test_time \n]
unset test_time

unset no(epilogue.eagle)
unset no(prologue.eagle)

if {[array size no] == 0} then {unset no}

source [file join $test_all_path epilogue.eagle]
Changes to Externals/Eagle/lib/Test1.0/constraints.eagle.
52
53
54
55
56
57
58
59

60
61
62
63
64
65
66
    #
    # NOTE: This job of this procedure is to return the list of "known"
    #       versions of Mono supported by the test suite infrastructure.
    #
    return [list \
        [list 2 0] [list 2 2] [list 2 4] [list 2 6] [list 2 8] [list 2 10] \
        [list 2 11] [list 2 12] [list 3 0] [list 3 1] [list 3 2] [list 3 3] \
        [list 3 4] [list 3 5] [list 3 6] [list 3 8] [list 3 10] [list 3 12]]

  }

  #
  # NOTE: This procedure was adapted from the one listed on the Tcl Wiki page
  #       at "http://wiki.tcl.tk/43".  It is only intended to be used on very
  #       small lists because of its heavy use of recursion and complexity on
  #       the order of O(N!).







|
>







52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
    #
    # NOTE: This job of this procedure is to return the list of "known"
    #       versions of Mono supported by the test suite infrastructure.
    #
    return [list \
        [list 2 0] [list 2 2] [list 2 4] [list 2 6] [list 2 8] [list 2 10] \
        [list 2 11] [list 2 12] [list 3 0] [list 3 1] [list 3 2] [list 3 3] \
        [list 3 4] [list 3 5] [list 3 6] [list 3 8] [list 3 10] [list 3 12] \
        [list 4 0]]
  }

  #
  # NOTE: This procedure was adapted from the one listed on the Tcl Wiki page
  #       at "http://wiki.tcl.tk/43".  It is only intended to be used on very
  #       small lists because of its heavy use of recursion and complexity on
  #       the order of O(N!).
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113

    #
    # NOTE: If this Eagle version lacks [interp readylimit] -OR- it has
    #       the default value (i.e. it always fully checks readiness),
    #       return true.
    #
    return [expr {
      [catch {interp readylimit {}} readylimit] != 0 || $readylimit == 0
    }]
  }

  #
  # NOTE: This procedure should return non-zero if the "whoami" command may
  #       be executed by the test suite infrastructure outside the context
  #       of any specific tests.







|







100
101
102
103
104
105
106
107
108
109
110
111
112
113
114

    #
    # NOTE: If this Eagle version lacks [interp readylimit] -OR- it has
    #       the default value (i.e. it always fully checks readiness),
    #       return true.
    #
    return [expr {
      [catch {interp readylimit {}} readylimit] || $readylimit == 0
    }]
  }

  #
  # NOTE: This procedure should return non-zero if the "whoami" command may
  #       be executed by the test suite infrastructure outside the context
  #       of any specific tests.
311
312
313
314
315
316
317




























318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
        # NOTE: If the test suite file exists, add it to the list of file
        #       names to process.
        #
        if {[file exists $fileName]} then {
          lappend fileNames $fileName
        }
      }




























    }

    #
    # NOTE: Check if the test package path is available.
    #
    if {[info exists ::test_path]} then {
      #
      # TODO: If additional test suite files are added within the test
      #       package path, add them here as well.
      #
      foreach fileNameOnly [list \
          all.eagle constraints.eagle epilogue.eagle pkgIndex.eagle \
          pkgIndex.tcl prologue.eagle] {
        #
        # NOTE: Check if the file resides in the test package directory.
        #
        set fileName [file join $::test_path $fileNameOnly]

        #
        # NOTE: If the test suite file exists, add it to the list of file







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










|
<
<







312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357


358
359
360
361
362
363
364
        # NOTE: If the test suite file exists, add it to the list of file
        #       names to process.
        #
        if {[file exists $fileName]} then {
          lappend fileNames $fileName
        }
      }

      #
      # TODO: If additional test suite files are added within the base
      #       package path, add them here as well.
      #
      foreach fileNameOnly [list \
          all.eagle constraints.eagle epilogue.eagle pkgIndex.eagle \
          pkgIndex.tcl prologue.eagle] {
        #
        # NOTE: First, check if the file resides in the Eagle-specific
        #       package sub-directory.  Failing that, fallback to using
        #       the base package path itself.
        #
        set fileName [file join \
            $::test_package_path Test1.0 $fileNameOnly]

        if {![file exists $fileName]} then {
          set fileName [file join $::test_package_path $fileNameOnly]
        }

        #
        # NOTE: If the test suite file exists, add it to the list of file
        #       names to process.
        #
        if {[file exists $fileName]} then {
          lappend fileNames $fileName
        }
      }
    }

    #
    # NOTE: Check if the test package path is available.
    #
    if {[info exists ::test_path]} then {
      #
      # TODO: If additional test suite files are added within the test
      #       package path, add them here as well.
      #
      foreach fileNameOnly [list all.eagle epilogue.eagle prologue.eagle] {


        #
        # NOTE: Check if the file resides in the test package directory.
        #
        set fileName [file join $::test_path $fileNameOnly]

        #
        # NOTE: If the test suite file exists, add it to the list of file
1582
1583
1584
1585
1586
1587
1588
















1589
1590
1591
1592
1593
1594
1595
      addConstraint timeIntensive

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

















  proc checkForMemoryIntensive { channel } {
    tputs $channel "---- checking for memory intensive testing... "

    #
    # NOTE: Are we allowed to do memory intensive testing?
    #







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







1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
      addConstraint timeIntensive

      tputs $channel yes\n
    } else {
      tputs $channel no\n
    }
  }

  proc checkForFullTest { channel } {
    tputs $channel "---- checking for full testing... "

    #
    # NOTE: Are we allowed to do full testing (i.e. to run rarely
    #       needed tests)?
    #
    if {![info exists ::no(fullTest)]} then {
      addConstraint fullTest

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

    #
    # NOTE: Are we allowed to do memory intensive testing?
    #
1945
1946
1947
1948
1949
1950
1951














































































1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
        addConstraint strongName

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














































































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

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

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

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







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


















|







1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
        addConstraint strongName

        tputs $channel yes\n
      } else {
        tputs $channel no\n
      }
    }

    proc checkForStrongNameKey { channel } {
      tputs $channel "---- checking for strong name key... "

      if {[catch {info engine PublicKeyToken} publicKeyToken] == 0 && \
          [string length $publicKeyToken] > 0} then {
        #
        # NOTE: Add a test constraint for this specific strong name key.
        #
        addConstraint [appendArgs strongName. $publicKeyToken]

        #
        # NOTE: Show the strong name key that we found.
        #
        tputs $channel [appendArgs "yes (" $publicKeyToken ")\n"]

        #
        # BUGBUG: Tcl 8.4 does not seem to like this expression because it
        #         contains the "ni" operator added in Tcl 8.5 (and Tcl 8.4
        #         tries to compile it even though it will only be evaluated
        #         in Eagle).
        #
        set expr {$publicKeyToken ni \
            "29c6297630be05eb 1e22ec67879739a2 358030063a832bc3"}

        if {[expr $expr]} then {
          #
          # NOTE: The Eagle core library is strong name signed with a key that
          #       is not official.  This is also not an error, per se; however,
          #       it may cause some tests to fail and it should be reported to
          #       the user and noted in the test suite log file.
          #
          addConstraint strongName.unofficial

          #
          # NOTE: Unless forbidden, issue and log a warning.
          #
          if {![info exists no(warningForStrongNameKey)] && \
              ![haveConstraint quiet]} then {
            tputs $channel [appendArgs \
                "==== WARNING: unofficial Eagle strong name signature " \
                "detected: " $publicKeyToken \n]
          }
        } else {
          #
          # NOTE: Several tests require one of the official strong name keys to
          #       be used in order for them to pass.
          #
          addConstraint strongName.official

          tputs $channel [appendArgs \
              "---- official Eagle strong name signature detected: " \
              $publicKeyToken \n]
        }
      } else {
        #
        # NOTE: The Eagle core library is not signed with a strong name key.
        #       This is not an error, per se; however, it may cause selected
        #       tests to fail and it should be reported to the user and noted
        #       in the test suite log file.
        #
        addConstraint strongName.none

        #
        # NOTE: Show that we did not find a strong name key.
        #
        tputs $channel no\n

        #
        # NOTE: Unless forbidden, issue and log a warning.
        #
        if {![info exists no(warningForStrongNameKey)] && \
            ![haveConstraint quiet]} then {
          tputs $channel \
              "==== WARNING: no Eagle strong name signature detected...\n"
        }
      }
    }

    proc checkForCertificate { channel } {
      tputs $channel "---- checking for certificate... "

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

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

        tputs $channel [appendArgs "yes (" $subject ")\n"]
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
      tputs $channel "---- checking for default application domain... "

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

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

        if {$default} then {
          addConstraint defaultAppDomain








|



|







2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
      tputs $channel "---- checking for default application domain... "

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

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

        if {$default} then {
          addConstraint defaultAppDomain

2372
2373
2374
2375
2376
2377
2378















































2379
2380
2381
2382
2383
2384
2385

        tputs $channel [appendArgs $result ", " $::tcl_platform(processBits) \
            -bit " " $::tcl_platform(machine) \n]
      } else {
        tputs $channel "no, unknown\n"
      }
    }
















































    proc checkForGarudaDll { channel } {
      #
      # NOTE: Skip automatic Tcl shell machine detection if we are not
      #       allowed to execute external commands.
      #
      if {[canExecTclShell]} then {







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







2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553

        tputs $channel [appendArgs $result ", " $::tcl_platform(processBits) \
            -bit " " $::tcl_platform(machine) \n]
      } else {
        tputs $channel "no, unknown\n"
      }
    }

    proc checkForTestCallStack { channel } {
      tputs $channel "---- checking for test call stack... "

      #
      # NOTE: Search for a call frame with associated arguments.
      #       At this point, there must be at least one such call
      #       frame (this one).  Therefore, this loop will always
      #       terminate.
      #
      set index 0; set arguments [list]
      set script {info level [info level]}

      while {1} {
        set level [appendArgs ## $index]

        if {[catch {uplevel $level $script} arguments] == 0} then {
          break
        }

        incr index
      }

      #
      # NOTE: Grab the command name from the arguments, if any.
      #
      set command [expr {
        [llength $arguments] > 0 ? [lindex $arguments 0] : ""
      }]

      #
      # HACK: Make sure the call stack does not end up confusing
      #       the tests that rely on absolute call frames.
      #
      if {$command in [list checkForTestCallStack]} then {
        addConstraint testCallStack

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

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

      tputs $channel [appendArgs "no (\"" $command "\")\n"]
    }

    proc checkForGarudaDll { channel } {
      #
      # NOTE: Skip automatic Tcl shell machine detection if we are not
      #       allowed to execute external commands.
      #
      if {[canExecTclShell]} then {
3218
3219
3220
3221
3222
3223
3224

















3225
3226
3227
3228
3229
3230
3231
3232
3233
          return
        }
      }

      tputs $channel no\n
    }


















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

      #
      # NOTE: Platform must be Windows for this constraint to even be
      #       checked (i.e. we require the registry).
      #
      if {[isWindows]} then {
        #







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







3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
          return
        }
      }

      tputs $channel no\n
    }

    proc getFrameworkSetup46Value {} {
      #
      # NOTE: Check if we are running on Windows 10 or later.
      #
      if {[isWindows] && $::tcl_platform(osVersion) >= 10.0} then {
        #
        # NOTE: We are running on Windows 10, return the special value.
        #
        return 393295
      }

      #
      # NOTE: We are not running on Windows 10, return the normal value.
      #
      return 393297
    }

    proc checkForNetFx4x { channel } {
      tputs $channel "---- checking for .NET Framework 4.x... "

      #
      # NOTE: Platform must be Windows for this constraint to even be
      #       checked (i.e. we require the registry).
      #
      if {[isWindows]} then {
        #
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273


3274
3275
3276
3277
3278

3279
3280
3281
3282
3283
3284
3285
          #
          # NOTE: If the "release" value is greater than or equal to 378758
          #       (or 378675 for Windows 8.1), then the .NET Framework 4.5.1
          #       is installed.  However, if the "release" value is also
          #       greater than or equal to 379893, then the .NET Framework
          #       4.5.2 is installed, which is an in-place upgrade to 4.5.1
          #       (and 4.5).  If the "release" value is also greater than or
          #       equal to 393246, then the .NET Framework 4.6 is installed,
          #       which is an in-place upgrade to 4.5.x.
          #
          # TODO: Change the value 393246 when the .NET Framework 4.6 goes
          #       final.
          #
          if {$release >= 393246} then {


            addConstraint dotNet46
            addConstraint dotNet46OrHigher

            set version 4.6
          } elseif {$release >= 379893} then {

            addConstraint dotNet452
            addConstraint dotNet452OrHigher

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







|
|
<
<
|

|
>
>





>







3445
3446
3447
3448
3449
3450
3451
3452
3453


3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
          #
          # NOTE: If the "release" value is greater than or equal to 378758
          #       (or 378675 for Windows 8.1), then the .NET Framework 4.5.1
          #       is installed.  However, if the "release" value is also
          #       greater than or equal to 379893, then the .NET Framework
          #       4.5.2 is installed, which is an in-place upgrade to 4.5.1
          #       (and 4.5).  If the "release" value is also greater than or
          #       equal to 393297 (393295 on Windows 10), then the .NET
          #       Framework 4.6 is installed, which is an in-place upgrade


          #       to 4.5.x.
          #
          if {$release >= [getFrameworkSetup46Value]} then {
            addConstraint dotNet451OrHigher
            addConstraint dotNet452OrHigher
            addConstraint dotNet46
            addConstraint dotNet46OrHigher

            set version 4.6
          } elseif {$release >= 379893} then {
            addConstraint dotNet451OrHigher
            addConstraint dotNet452
            addConstraint dotNet452OrHigher

            set version 4.5.2
          } elseif {$release >= 378675} then {
            addConstraint dotNet451
            addConstraint dotNet451OrHigher
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
        checkForGaruda checkForShell checkForDebug checkForTk checkForVersion \
        checkForCommand checkForNamespaces checkForTestExec \
        checkForTestMachine checkForTestPlatform checkForTestConfiguration \
        checkForTestSuffix checkForFile checkForPathFile checkForNativeCode \
        checkForTip127 checkForTip194 checkForTip207 checkForTip241 \
        checkForTip285 checkForTip405 checkForTip426 checkForTip429 \
        checkForTiming checkForPerformance checkForBigLists \
        checkForTimeIntensive checkForMemoryIntensive checkForStackIntensive \
        checkForInteractive checkForInteractiveCommand checkForUserInteraction \
        checkForNetwork checkForCompileOption checkForKnownCompileOptions] \
        false false

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







|
|
|
|













3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
        checkForGaruda checkForShell checkForDebug checkForTk checkForVersion \
        checkForCommand checkForNamespaces checkForTestExec \
        checkForTestMachine checkForTestPlatform checkForTestConfiguration \
        checkForTestSuffix checkForFile checkForPathFile checkForNativeCode \
        checkForTip127 checkForTip194 checkForTip207 checkForTip241 \
        checkForTip285 checkForTip405 checkForTip426 checkForTip429 \
        checkForTiming checkForPerformance checkForBigLists \
        checkForTimeIntensive checkForFullTest checkForMemoryIntensive \
        checkForStackIntensive checkForInteractive checkForInteractiveCommand \
        checkForUserInteraction checkForNetwork checkForCompileOption \
        checkForKnownCompileOptions] false false

    ###########################################################################
    ############################## END Tcl ONLY ###############################
    ###########################################################################
  }

  #
  # NOTE: Provide the Eagle test constraints package to the interpreter.
  #
  package provide Eagle.Test.Constraints \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}

Changes to Externals/Eagle/lib/Test1.0/epilogue.eagle.
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

  #
  # 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] && [llength [info commands object]] > 0} 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 \







<








|
<







21
22
23
24
25
26
27

28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43

  #
  # 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] && [llength [info commands object]] > 0} 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 epilogue, current frame not for this script"

    }
  }

  #
  # NOTE: Make sure all the variables used by this epilogue are unset.
  #
  unset -nocomplain memory stack name count passedOrSkipped percent \
Changes to Externals/Eagle/lib/Test1.0/prologue.eagle.
19
20
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
46
47
    error "cannot run, current level is not global"
  }

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

  #
  # NOTE: Indicate that the test suite is currently running.
  #
  if {![info exists test_suite_running] || !$test_suite_running} then {
    set test_suite_running true
  }








  #
  # NOTE: Set the location of the test suite, if necessary.
  #
  if {![info exists test_path]} then {
    set test_path [file normalize [file dirname [info script]]]

  }

  #
  # NOTE: Set the location of the test suite data, if necessary.
  #
  if {![info exists test_data_path]} then {
    set test_data_path [file join $test_path data]







|
|








>
>
>
>
>
>
>




|
>







19
20
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
46
47
48
49
50
51
52
53
54
55
    error "cannot run, current level is not global"
  }

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

  #
  # NOTE: Indicate that the test suite is currently running.
  #
  if {![info exists test_suite_running] || !$test_suite_running} then {
    set test_suite_running true
  }

  #
  # NOTE: Set the location of the test suite package, if necessary.
  #
  if {![info exists test_all_path]} then {
    set test_all_path [file normalize [file dirname [info script]]]
  }

  #
  # NOTE: Set the location of the test suite, if necessary.
  #
  if {![info exists test_path]} then {
    set test_path [file normalize [file join \
        [file dirname [file dirname $test_all_path]] Library Tests]]
  }

  #
  # NOTE: Set the location of the test suite data, if necessary.
  #
  if {![info exists test_data_path]} then {
    set test_data_path [file join $test_path data]
177
178
179
180
181
182
183





184



185
186
187
188
189
190
191
  # NOTE: Make sure our primary package path is part of the auto-path.
  #
  if {[lsearch -exact $auto_path $test_package_path] == -1} then {
    lappend auto_path $test_package_path
  }

  #





  # NOTE: Make sure our test package path is part of the auto-path.



  #
  if {[lsearch -exact $auto_path $test_path] == -1} then {
    lappend auto_path $test_path
  }

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








>
>
>
>
>
|
>
>
>







185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
  # NOTE: Make sure our primary package path is part of the auto-path.
  #
  if {[lsearch -exact $auto_path $test_package_path] == -1} then {
    lappend auto_path $test_package_path
  }

  #
  # NOTE: Make sure the test suite package is part of the auto-path.
  #
  if {[lsearch -exact $auto_path $test_all_path] == -1} then {
    lappend auto_path $test_all_path
  }

  #
  # NOTE: Make sure the test suite is part of the auto-path.  This is
  #       now done for legacy compatibility only.
  #
  if {[lsearch -exact $auto_path $test_path] == -1} then {
    lappend auto_path $test_path
  }

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

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
  #
  # 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] && [llength [info commands object]] > 0} 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







<








|
<







232
233
234
235
236
237
238

239
240
241
242
243
244
245
246
247

248
249
250
251
252
253
254
  #
  # 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] && [llength [info commands object]] > 0} 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 prologue, current frame not for this script"

    }
  }

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

  #
  # NOTE: Set the local root directory of the source checkout (i.e. of Eagle
305
306
307
308
309
310
311


312
313
314
315
316
317
318
319
320
321
322
323
324
  set test_flags(-stopOnLeak) ""; # default to continue on leak.
  set test_flags(-exitOnComplete) ""; # default to not exit after complete.
  set test_flags(-preTest) ""; # default to not evaluating anything.
  set test_flags(-postTest) ""; # default to not evaluating anything.
  set test_flags(-preWait) ""; # default to not waiting.
  set test_flags(-postWait) ""; # default to not waiting.
  set test_flags(-tclsh) ""; # Tcl shell, default to empty.



  #
  # NOTE: Check for and process any command line arguments.
  #
  if {[info exists argv]} then {
    eval processTestArguments test_flags $argv

    if {[info exists test_flags(-no)] && \
        [string length $test_flags(-no)] > 0} then {
      #
      # NOTE: Set the test run restrictions based on the provided command line
      #       argument value (which is assumed to be a "dictionary-style" list
      #       containing name/value pairs to add to the global "no" array).







>
>





|







319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
  set test_flags(-stopOnLeak) ""; # default to continue on leak.
  set test_flags(-exitOnComplete) ""; # default to not exit after complete.
  set test_flags(-preTest) ""; # default to not evaluating anything.
  set test_flags(-postTest) ""; # default to not evaluating anything.
  set test_flags(-preWait) ""; # default to not waiting.
  set test_flags(-postWait) ""; # default to not waiting.
  set test_flags(-tclsh) ""; # Tcl shell, default to empty.
  set test_flags(-bad) [list]; # these are the unrecognized arguments.
  set test_flags(-no) [list]; # default to not having any restrictions.

  #
  # NOTE: Check for and process any command line arguments.
  #
  if {[info exists argv]} then {
    set test_flags(-bad) [eval processTestArguments test_flags false $argv]

    if {[info exists test_flags(-no)] && \
        [string length $test_flags(-no)] > 0} then {
      #
      # NOTE: Set the test run restrictions based on the provided command line
      #       argument value (which is assumed to be a "dictionary-style" list
      #       containing name/value pairs to add to the global "no" array).
728
729
730
731
732
733
734





735
736
737
738
739
740
741

  tputs $test_channel [appendArgs "---- executable: \"" \
      $bin_file \"\n]

  tputs $test_channel [appendArgs "---- command line: " \
      [expr {[info exists argv] && [string length $argv] > 0 ? \
          $argv : "<none>"}] \n]






  tputs $test_channel [appendArgs "---- logging to: " \
      [expr {[info exists test_log] && [string length $test_log] > 0 ? \
          [appendArgs \" $test_log \"] : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- pass threshold: " \
      [expr {[info exists test_threshold] && \







>
>
>
>
>







744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762

  tputs $test_channel [appendArgs "---- executable: \"" \
      $bin_file \"\n]

  tputs $test_channel [appendArgs "---- command line: " \
      [expr {[info exists argv] && [string length $argv] > 0 ? \
          $argv : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- unrecognized arguments: " \
      [expr {[info exists test_flags(-bad)] && \
          [string length $test_flags(-bad)] > 0 ? \
              $test_flags(-bad) : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- logging to: " \
      [expr {[info exists test_log] && [string length $test_log] > 0 ? \
          [appendArgs \" $test_log \"] : "<none>"}] \n]

  tputs $test_channel [appendArgs "---- pass threshold: " \
      [expr {[info exists test_threshold] && \
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
      #       "debug-1.4", "glob-99.*", "object-10.*", "perf-2.2",
      #       and various other places within the test suite code
      #       itself.
      #
      checkForQuiet $test_channel false
    }

    #
    # NOTE: Has strong name key detection been disabled?
    #
    if {![info exists no(strongNameKey)]} then {
      catch {info engine PublicKeyToken} publicKeyToken

      if {[string length $publicKeyToken] == 0} then {
        #
        # NOTE: The Eagle core library is not signed with a strong name key.
        #       This is not an error, per se; however, it may cause selected
        #       tests to fail and it should be reported to the user and noted
        #       in the test suite log file.
        #
        addConstraint strongName.none

        if {![info exists no(warningForStrongNameKey)] && \
            ![haveConstraint quiet]} then {
          tputs $test_channel \
              "==== WARNING: no Eagle strong name signature detected...\n"
        }
      } else {
        #
        # NOTE: Add a test constraint for this specific strong name key.
        #
        addConstraint [appendArgs strongName. $publicKeyToken]

        #
        # BUGBUG: Tcl 8.4 does not seem to like this expression because it
        #         contains the "ni" operator added in Tcl 8.5 (and Tcl 8.4
        #         tries to compile it even though it will only be evaluated
        #         in Eagle).
        #
        set expr {$publicKeyToken ni \
            "29c6297630be05eb 1e22ec67879739a2 358030063a832bc3"}

        if {[expr $expr]} then {
          #
          # NOTE: The Eagle core library is strong name signed with a key that
          #       is not official.  This is also not an error, per se; however,
          #       it may cause some tests to fail and it should be reported to
          #       the user and noted in the test suite log file.
          #
          addConstraint strongName.unofficial

          if {![info exists no(warningForStrongNameKey)] && \
              ![haveConstraint quiet]} then {
            tputs $test_channel [appendArgs \
                "==== WARNING: unofficial Eagle strong name signature " \
                "detected: " $publicKeyToken \n]
          }
        } else {
          #
          # NOTE: Several tests require one of the official strong name keys to
          #       be used in order for them to pass.
          #
          addConstraint strongName.official

          tputs $test_channel [appendArgs \
              "---- official Eagle strong name signature detected: " \
              $publicKeyToken \n]
        }

        unset expr
      }

      unset publicKeyToken
    }

    #
    # NOTE: Has administrator detection support been disabled?  We do
    #       this check [nearly] first as it may [eventually] be used
    #       to help determine if other constraints should be skipped.
    #
    if {![info exists no(administrator)]} then {
      checkForAdministrator $test_channel







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







901
902
903
904
905
906
907




































































908
909
910
911
912
913
914
      #       "debug-1.4", "glob-99.*", "object-10.*", "perf-2.2",
      #       and various other places within the test suite code
      #       itself.
      #
      checkForQuiet $test_channel false
    }





































































    #
    # NOTE: Has administrator detection support been disabled?  We do
    #       this check [nearly] first as it may [eventually] be used
    #       to help determine if other constraints should be skipped.
    #
    if {![info exists no(administrator)]} then {
      checkForAdministrator $test_channel
1039
1040
1041
1042
1043
1044
1045







1046
1047
1048
1049
1050
1051
1052
    if {![info exists no(machine)]} then {
      checkForMachine $test_channel 32 intel; # (i.e. x86)
      checkForMachine $test_channel 32 arm;   # (i.e. arm)
      checkForMachine $test_channel 64 ia64;  # (i.e. itanium)
      checkForMachine $test_channel 64 amd64; # (i.e. x64)
    }








    #
    # NOTE: Has culture detection support been disabled?
    #
    if {![info exists no(culture)]} then {
      checkForCulture $test_channel
    }








>
>
>
>
>
>
>







992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
    if {![info exists no(machine)]} then {
      checkForMachine $test_channel 32 intel; # (i.e. x86)
      checkForMachine $test_channel 32 arm;   # (i.e. arm)
      checkForMachine $test_channel 64 ia64;  # (i.e. itanium)
      checkForMachine $test_channel 64 amd64; # (i.e. x64)
    }

    #
    # NOTE: Has test suite call stack probing been disabled?
    #
    if {![info exists no(testCallStack)]} then {
      checkForTestCallStack $test_channel
    }

    #
    # NOTE: Has culture detection support been disabled?
    #
    if {![info exists no(culture)]} then {
      checkForCulture $test_channel
    }

1066
1067
1068
1069
1070
1071
1072







1073
1074
1075
1076
1077
1078
1079

    #
    # NOTE: Has strong name detection support been disabled?
    #
    if {![info exists no(strongName)]} then {
      checkForStrongName $test_channel
    }








    #
    # NOTE: Has certificate detection support been disabled?
    #
    if {![info exists no(certificate)]} then {
      checkForCertificate $test_channel
    }







>
>
>
>
>
>
>







1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046

    #
    # NOTE: Has strong name detection support been disabled?
    #
    if {![info exists no(strongName)]} then {
      checkForStrongName $test_channel
    }

    #
    # NOTE: Has strong name key detection been disabled?
    #
    if {![info exists no(strongNameKey)]} then {
      checkForStrongNameKey $test_channel
    }

    #
    # NOTE: Has certificate detection support been disabled?
    #
    if {![info exists no(certificate)]} then {
      checkForCertificate $test_channel
    }
1613
1614
1615
1616
1617
1618
1619



































1620
1621
1622
1623
1624
1625
1626
        #
        # NOTE: For test "lpermute-1.3".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestPermute*
      }




































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







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







1580
1581
1582
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
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
        #
        # NOTE: For test "lpermute-1.3".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestPermute*
      }

      if {![info exists no(testDynamicCallback)]} then {
        #
        # NOTE: For tests "object-8.1??".
        #
        checkForObjectMember $test_channel Eagle._Tests.Default \
            *TestCallDynamicCallback0*

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

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

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

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

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

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

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

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

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

      #
      # NOTE: Has DateTime testing support been disabled?
      #
      if {![info exists no(testDateTime)]} then {
        #
        # NOTE: For test "vwait-1.11".
        #
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
      #
      # NOTE: For test "hash-1.1".
      #
      checkForNetFx20ServicePack $test_channel
    }

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

    #
    # NOTE: Has target framework testing support been disabled?
    #
    if {![info exists no(targetFramework)]} then {
      checkForTargetFramework $test_channel







|

|



|







2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
      #
      # NOTE: For test "hash-1.1".
      #
      checkForNetFx20ServicePack $test_channel
    }

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

    #
    # NOTE: Has target framework testing support been disabled?
    #
    if {![info exists no(targetFramework)]} then {
      checkForTargetFramework $test_channel
2351
2352
2353
2354
2355
2356
2357







2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371







2372
2373
2374
2375
2376
2377
2378
    #
    # NOTE: For tests "benchmark-1.3[89]" and "benchmark-1.40".
    #
    if {![info exists no(benchmark.txt)]} then {
      checkForFile $test_channel [file join $test_data_path benchmark.txt]
    }








    #
    # NOTE: For test "garuda-1.1".
    #
    if {![info exists no(pkgAll.tcl)]} then {
      checkForFile $test_channel [file join $base_path Native Package \
          Tests all.tcl] pkgAll.tcl
    }

    #
    # NOTE: For tests "subst-1.*".
    #
    if {![info exists no(bad_subst.txt)]} then {
      checkForFile $test_channel [file join $test_data_path bad_subst.txt]
    }








    #
    # NOTE: This is not currently used by any tests.
    #
    if {![info exists no(evaluate.eagle)]} then {
      checkForFile $test_channel [file join $test_data_path evaluate.eagle]
    }







>
>
>
>
>
>
>














>
>
>
>
>
>
>







2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
    #
    # NOTE: For tests "benchmark-1.3[89]" and "benchmark-1.40".
    #
    if {![info exists no(benchmark.txt)]} then {
      checkForFile $test_channel [file join $test_data_path benchmark.txt]
    }

    #
    # NOTE: For test "benchmark-1.42".
    #
    if {![info exists no(pngDump.txt)]} then {
      checkForFile $test_channel [file join $test_data_path pngDump.txt]
    }

    #
    # NOTE: For test "garuda-1.1".
    #
    if {![info exists no(pkgAll.tcl)]} then {
      checkForFile $test_channel [file join $base_path Native Package \
          Tests all.tcl] pkgAll.tcl
    }

    #
    # NOTE: For tests "subst-1.*".
    #
    if {![info exists no(bad_subst.txt)]} then {
      checkForFile $test_channel [file join $test_data_path bad_subst.txt]
    }

    #
    # NOTE: For test "processIsolation-1.1".
    #
    if {![info exists no(isolated.eagle)]} then {
      checkForFile $test_channel [file join $test_data_path isolated.eagle]
    }

    #
    # NOTE: This is not currently used by any tests.
    #
    if {![info exists no(evaluate.eagle)]} then {
      checkForFile $test_channel [file join $test_data_path evaluate.eagle]
    }
2619
2620
2621
2622
2623
2624
2625




2626
2627
2628
2629
2630
2631
2632
  if {![info exists no(checkForBigLists)]} then {
    checkForBigLists $test_channel
  }

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





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

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







>
>
>
>







2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
  if {![info exists no(checkForBigLists)]} then {
    checkForBigLists $test_channel
  }

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

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

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

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